1 /* -*-C-*- 2 3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 4 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 5 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts 6 Institute of Technology 7 8 This file is part of MIT/GNU Scheme. 9 10 MIT/GNU Scheme is free software; you can redistribute it and/or modify 11 it under the terms of the GNU General Public License as published by 12 the Free Software Foundation; either version 2 of the License, or (at 13 your option) any later version. 14 15 MIT/GNU Scheme is distributed in the hope that it will be useful, but 16 WITHOUT ANY WARRANTY; without even the implied warranty of 17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 General Public License for more details. 19 20 You should have received a copy of the GNU General Public License 21 along with MIT/GNU Scheme; if not, write to the Free Software 22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 23 USA. 24 25 */ 26 27 /* This file defines the macros which define and manipulate Scheme 28 objects. This is the lowest level of abstraction in this program. 29 */ 30 #ifndef SCM_OBJECT_H 31 #define SCM_OBJECT_H 32 33 #include "config.h" 34 #include "types.h" 35 36 #define TYPE_CODE_LENGTH (6U) 37 38 #if defined(MIN_TYPE_CODE_LENGTH) && (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH) 39 # include ";; inconsistency: TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH" 40 #endif 41 42 typedef unsigned long SCHEME_OBJECT; 43 #define SIZEOF_SCHEME_OBJECT SIZEOF_UNSIGNED_LONG 44 #define OBJECT_LENGTH ((unsigned int) (CHAR_BIT * SIZEOF_UNSIGNED_LONG)) 45 46 /* A convenience definition since "unsigned char" is so verbose. */ 47 typedef unsigned char byte_t; 48 49 #if (TYPE_CODE_LENGTH == 6U) 50 # define N_TYPE_CODES (0x40) 51 # if (SIZEOF_UNSIGNED_LONG == 4) /* 32 bit word versions */ 52 # define DATUM_LENGTH (26U) 53 # define DATUM_MASK (0x03FFFFFFL) 54 # define TYPE_CODE_MASK (0XFC000000L) 55 # define FIXNUM_LENGTH (25U) /* doesn't include sign */ 56 # define FIXNUM_MASK (0x01FFFFFFL) 57 # define FIXNUM_SIGN_BIT (0x02000000L) 58 # define SIGN_MASK (0xFE000000L) 59 # define SMALLEST_FIXNUM (-33554432L) 60 # define BIGGEST_FIXNUM (33554431L) 61 # define HALF_DATUM_LENGTH (13U) 62 # define HALF_DATUM_MASK (0x00001FFFL) 63 # endif 64 # if (SIZEOF_UNSIGNED_LONG == 8) /* 64 bit word versions */ 65 # define DATUM_LENGTH (58U) 66 # define DATUM_MASK (0x03FFFFFFFFFFFFFFL) 67 # define TYPE_CODE_MASK (0XFC00000000000000L) 68 # define FIXNUM_LENGTH (57U) /* doesn't include sign */ 69 # define FIXNUM_MASK (0x01FFFFFFFFFFFFFFL) 70 # define FIXNUM_SIGN_BIT (0x0200000000000000L) 71 # define SIGN_MASK (0xFE00000000000000L) 72 # define SMALLEST_FIXNUM (-144115188075855872L) 73 # define BIGGEST_FIXNUM (144115188075855871L) 74 # define HALF_DATUM_LENGTH (29U) 75 # define HALF_DATUM_MASK (0x000000001FFFFFFFL) 76 # endif 77 #endif 78 79 #ifndef DATUM_LENGTH /* Safe versions */ 80 # define N_TYPE_CODES (1U << TYPE_CODE_LENGTH) 81 # define DATUM_LENGTH (OBJECT_LENGTH - TYPE_CODE_LENGTH) 82 # define DATUM_MASK ((1UL << DATUM_LENGTH) - 1UL) 83 # define TYPE_CODE_MASK ((N_TYPE_CODES - 1U) << DATUM_LENGTH) 84 # define FIXNUM_LENGTH (DATUM_LENGTH - 1U) /* doesn't include sign */ 85 # define FIXNUM_MASK ((1UL << FIXNUM_LENGTH) - 1UL) 86 # define FIXNUM_SIGN_BIT (1UL << FIXNUM_LENGTH) 87 # define SIGN_MASK \ 88 (((unsigned long) ((N_TYPE_CODES * 2U) - 1U)) << FIXNUM_LENGTH) 89 # define SMALLEST_FIXNUM SIGN_MASK 90 # define BIGGEST_FIXNUM ((1UL << FIXNUM_LENGTH) - 1UL) 91 # define HALF_DATUM_LENGTH (DATUM_LENGTH / 2U) 92 # define HALF_DATUM_MASK ((1UL << HALF_DATUM_LENGTH) - 1UL) 93 #endif 94 95 /* Basic object structure */ 96 97 #define OBJECT_TYPE(object) ((object) >> DATUM_LENGTH) 98 #define OBJECT_DATUM(object) ((object) & DATUM_MASK) 99 #define OBJECT_ADDRESS(object) (DATUM_TO_ADDRESS (OBJECT_DATUM (object))) 100 101 #define MAKE_OBJECT(type, datum) \ 102 ((((unsigned long) (type)) << DATUM_LENGTH) | (datum)) 103 104 #define OBJECT_NEW_TYPE(type, datum_object) \ 105 (MAKE_OBJECT ((type), (OBJECT_DATUM (datum_object)))) 106 107 #define OBJECT_NEW_DATUM(type_object, datum) \ 108 (MAKE_OBJECT ((OBJECT_TYPE (type_object)), (datum))) 109 110 #define MAKE_OBJECT_FROM_OBJECTS(type_object, datum_object) \ 111 (MAKE_OBJECT ((OBJECT_TYPE (type_object)), (OBJECT_DATUM (datum_object)))) 112 113 #define MAKE_POINTER_OBJECT(type, address) \ 114 (MAKE_OBJECT ((type), (ADDRESS_TO_DATUM (address)))) 115 116 #define OBJECT_NEW_ADDRESS(object, address) \ 117 (OBJECT_NEW_DATUM ((object), (ADDRESS_TO_DATUM (address)))) 118 119 /* Machine dependencies */ 120 121 #ifndef HEAP_MALLOC 122 # define HEAP_MALLOC OS_malloc_init 123 #endif 124 125 #ifdef HEAP_IN_LOW_MEMORY /* Storing absolute addresses */ 126 127 #define ALLOCATE_HEAP_SPACE(space, low, high) do \ 128 { \ 129 unsigned long _space = (space); \ 130 SCHEME_OBJECT * _low \ 131 = ((SCHEME_OBJECT *) \ 132 (HEAP_MALLOC ((sizeof (SCHEME_OBJECT)) * _space))); \ 133 \ 134 (low) = _low; \ 135 (high) = (_low + _space); \ 136 } while (0) 137 138 #ifndef DATUM_TO_ADDRESS 139 # define DATUM_TO_ADDRESS(datum) ((SCHEME_OBJECT *) (datum)) 140 #endif 141 142 #ifndef ADDRESS_TO_DATUM 143 # define ADDRESS_TO_DATUM(address) ((SCHEME_OBJECT) (address)) 144 #endif 145 146 #else /* not HEAP_IN_LOW_MEMORY */ 147 148 extern SCHEME_OBJECT * memory_base; 149 150 #define ALLOCATE_HEAP_SPACE(space, low, high) do \ 151 { \ 152 unsigned long _space = (space); \ 153 memory_base = ((SCHEME_OBJECT *) \ 154 (HEAP_MALLOC ((sizeof (SCHEME_OBJECT)) * _space))); \ 155 (low) = memory_base; \ 156 (high) = (memory_base + _space); \ 157 } while (0) 158 159 #define MEMBASE memory_base 160 161 /* These use the MEMBASE macro so that C-compiled code can cache 162 memory_base locally and use the local version. */ 163 164 #ifndef DATUM_TO_ADDRESS 165 # define DATUM_TO_ADDRESS(datum) ((SCHEME_OBJECT *) ((datum) + MEMBASE)) 166 #endif 167 168 #ifndef ADDRESS_TO_DATUM 169 # define ADDRESS_TO_DATUM(address) ((SCHEME_OBJECT) ((address) - MEMBASE)) 170 #endif 171 172 #endif /* not HEAP_IN_LOW_MEMORY */ 173 174 /* Lots of type predicates */ 175 176 #define FIXNUM_P(object) ((OBJECT_TYPE (object)) == TC_FIXNUM) 177 #define BIGNUM_P(object) ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM) 178 #define FLONUM_P(object) ((OBJECT_TYPE (object)) == TC_BIG_FLONUM) 179 #define COMPLEX_P(object) ((OBJECT_TYPE (object)) == TC_COMPLEX) 180 #define CHARACTER_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER) 181 #define STRING_P(object) ((OBJECT_TYPE (object)) == TC_CHARACTER_STRING) 182 #define BIT_STRING_P(object) ((OBJECT_TYPE (object)) == TC_BIT_STRING) 183 #define CELL_P(object) ((OBJECT_TYPE (object)) == TC_CELL) 184 #define PAIR_P(object) ((OBJECT_TYPE (object)) == TC_LIST) 185 #define WEAK_PAIR_P(object) ((OBJECT_TYPE (object)) == TC_WEAK_CONS) 186 #define VECTOR_P(object) ((OBJECT_TYPE (object)) == TC_VECTOR) 187 #define RECORD_P(object) ((OBJECT_TYPE (object)) == TC_RECORD) 188 #define BOOLEAN_P(object) (((object) == SHARP_T) || ((object) == SHARP_F)) 189 #define REFERENCE_TRAP_P(object) ((OBJECT_TYPE (object)) == TC_REFERENCE_TRAP) 190 #define PRIMITIVE_P(object) ((OBJECT_TYPE (object)) == TC_PRIMITIVE) 191 #define PROMISE_P(object) ((OBJECT_TYPE (object)) == TC_DELAYED) 192 #define APPARENT_LIST_P(object) ((EMPTY_LIST_P (object)) || (PAIR_P (object))) 193 #define CONTROL_POINT_P(object) ((OBJECT_TYPE (object)) == TC_CONTROL_POINT) 194 #define BROKEN_HEART_P(object) ((OBJECT_TYPE (object)) == TC_BROKEN_HEART) 195 #define RETURN_CODE_P(object) ((OBJECT_TYPE (object)) == TC_RETURN_CODE) 196 #define EPHEMERON_P(object) ((OBJECT_TYPE (object)) == TC_EPHEMERON) 197 198 #define NON_MARKED_VECTOR_P(object) \ 199 ((OBJECT_TYPE (object)) == TC_NON_MARKED_VECTOR) 200 201 #define SYMBOL_P(object) \ 202 ((INTERNED_SYMBOL_P (object)) || (UNINTERNED_SYMBOL_P (object))) 203 204 #define INTERNED_SYMBOL_P(object) \ 205 ((OBJECT_TYPE (object)) == TC_INTERNED_SYMBOL) 206 207 #define UNINTERNED_SYMBOL_P(object) \ 208 ((OBJECT_TYPE (object)) == TC_UNINTERNED_SYMBOL) 209 210 #define INTEGER_P(object) \ 211 (((OBJECT_TYPE (object)) == TC_FIXNUM) \ 212 || ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM)) 213 214 #define REAL_P(object) \ 215 (((OBJECT_TYPE (object)) == TC_FIXNUM) \ 216 || ((OBJECT_TYPE (object)) == TC_BIG_FIXNUM) \ 217 || ((OBJECT_TYPE (object)) == TC_BIG_FLONUM)) 218 219 #define HUNK3_P(object) \ 220 (((OBJECT_TYPE (object)) == TC_HUNK3_A) \ 221 || ((OBJECT_TYPE (object)) == TC_HUNK3_B)) 222 223 #define INTERPRETER_APPLICABLE_P interpreter_applicable_p 224 225 #define ENVIRONMENT_P(env) \ 226 (((OBJECT_TYPE (env)) == TC_ENVIRONMENT) || (GLOBAL_FRAME_P (env))) 227 228 #define EMPTY_LIST_P(object) ((object) == EMPTY_LIST) 229 230 /* Memory Operations */ 231 232 #define MEMORY_REF(obj, i) ((OBJECT_ADDRESS (obj)) [(i)]) 233 #define MEMORY_SET(obj, i, value) ((MEMORY_REF (obj, i)) = (value)) 234 #define MEMORY_LOC(obj, i) (& (MEMORY_REF (obj, i))) 235 236 /* Pair Operations */ 237 238 #define PAIR_CAR_LOC(pair) (MEMORY_LOC ((pair), CONS_CAR)) 239 #define PAIR_CDR_LOC(pair) (MEMORY_LOC ((pair), CONS_CDR)) 240 #define PAIR_CAR(pair) (MEMORY_REF ((pair), CONS_CAR)) 241 #define PAIR_CDR(pair) (MEMORY_REF ((pair), CONS_CDR)) 242 #define SET_PAIR_CAR(pair, car) MEMORY_SET ((pair), CONS_CAR, (car)) 243 #define SET_PAIR_CDR(pair, cdr) MEMORY_SET ((pair), CONS_CDR, (cdr)) 244 245 /* Vector Operations */ 246 247 #define VECTOR_LENGTH(v) (OBJECT_DATUM (MEMORY_REF ((v), 0))) 248 249 #define SET_VECTOR_LENGTH(v, length) \ 250 (MEMORY_SET ((v), 0, (OBJECT_NEW_DATUM ((MEMORY_REF ((v), 0)), (length))))) 251 252 #define VECTOR_LOC(v, i) (MEMORY_LOC ((v), ((i) + 1))) 253 #define VECTOR_REF(v, i) (MEMORY_REF ((v), ((i) + 1))) 254 #define VECTOR_SET(v, i, object) MEMORY_SET ((v), ((i) + 1), (object)) 255 256 /* String Operations */ 257 258 /* Add 1 byte to length to account for '\0' at end of string. 259 Add 1 word to length to account for string header word. */ 260 #define STRING_LENGTH_TO_GC_LENGTH(n_chars) \ 261 ((BYTES_TO_WORDS ((n_chars) + 1)) + 1) 262 263 #define STRING_LENGTH(s) \ 264 (OBJECT_DATUM (MEMORY_REF ((s), STRING_LENGTH_INDEX))) 265 266 #define SET_STRING_LENGTH(s, n_chars) do \ 267 { \ 268 MEMORY_SET ((s), \ 269 STRING_LENGTH_INDEX, \ 270 (MAKE_OBJECT (0, (n_chars)))); \ 271 STRING_SET ((s), (n_chars), '\0'); \ 272 } while (0) 273 274 /* Subtract 1 to account for the fact that we maintain a '\0' 275 at the end of the string. */ 276 #define MAXIMUM_STRING_LENGTH(s) \ 277 ((((VECTOR_LENGTH (s)) - 1) * (sizeof (SCHEME_OBJECT))) - 1) 278 279 #define SET_MAXIMUM_STRING_LENGTH(s, n_chars) \ 280 (SET_VECTOR_LENGTH ((s), (STRING_LENGTH_TO_GC_LENGTH (n_chars)))) 281 282 #define STRING_LOC(s, i) \ 283 (((unsigned char *) (MEMORY_LOC (s, STRING_CHARS))) + (i)) 284 285 #define STRING_POINTER(s) ((char *) (MEMORY_LOC (s, STRING_CHARS))) 286 #define STRING_BYTE_PTR(s) ((byte_t *) (MEMORY_LOC (s, STRING_CHARS))) 287 288 #define STRING_REF(s, i) (* (STRING_LOC ((s), (i)))) 289 #define STRING_SET(s, i, c) ((* (STRING_LOC ((s), (i)))) = (c)) 290 291 /* Character Operations */ 292 293 #define ASCII_LENGTH CHAR_BIT /* CHAR_BIT in config.h - 8 for unix */ 294 #define CODE_LENGTH 21 295 #define BITS_LENGTH 4 296 #define MIT_ASCII_LENGTH 25 297 298 #define CHAR_BITS_META 0x1 299 #define CHAR_BITS_CONTROL 0x2 300 #define CHAR_BITS_SUPER 0x4 301 #define CHAR_BITS_HYPER 0x8 302 303 #define MAX_ASCII (1UL << ASCII_LENGTH) 304 #define MAX_CODE (1UL << CODE_LENGTH) 305 #define MAX_BITS (1UL << BITS_LENGTH) 306 #define MAX_MIT_ASCII (1UL << MIT_ASCII_LENGTH) 307 308 #define MASK_ASCII (MAX_ASCII - 1) 309 #define CHAR_MASK_CODE (MAX_CODE - 1) 310 #define CHAR_MASK_BITS (MAX_BITS - 1) 311 #define MASK_MIT_ASCII (MAX_MIT_ASCII - 1) 312 313 #define ASCII_TO_CHAR(ascii) (MAKE_OBJECT (TC_CHARACTER, (ascii))) 314 #define CHAR_TO_ASCII_P(object) ((OBJECT_DATUM (object)) < MAX_ASCII) 315 #define CHAR_TO_ASCII(object) ((object) & MASK_ASCII) 316 317 #define MAKE_CHAR(bits, code) \ 318 (MAKE_OBJECT (TC_CHARACTER, \ 319 ((((unsigned long) (bits)) << (CODE_LENGTH)) \ 320 | ((unsigned long) (code))))) 321 322 #define CHAR_BITS(c) (((OBJECT_DATUM (c)) >> CODE_LENGTH) & CHAR_MASK_BITS) 323 #define CHAR_CODE(c) ((OBJECT_DATUM (c)) & CHAR_MASK_CODE) 324 325 /* Fixnum Operations */ 326 327 #define FIXNUM_ZERO_P(fixnum) ((OBJECT_DATUM (fixnum)) == 0) 328 #define FIXNUM_NEGATIVE_P(fixnum) (((fixnum) & FIXNUM_SIGN_BIT) != 0) 329 #define UNSIGNED_FIXNUM_P(x) ((FIXNUM_P (x)) && (!FIXNUM_NEGATIVE_P (x))) 330 #define FIXNUM_EQUAL_P(x, y) ((OBJECT_DATUM (x)) == (OBJECT_DATUM (y))) 331 #define FIXNUM_LESS_P(x, y) ((FIXNUM_TO_LONG (x)) < (FIXNUM_TO_LONG (y))) 332 333 #define FIXNUM_POSITIVE_P(fixnum) \ 334 (! ((FIXNUM_ZERO_P (fixnum)) || (FIXNUM_NEGATIVE_P (fixnum)))) 335 336 #define UNSIGNED_FIXNUM_TO_LONG(fixnum) ((long) (OBJECT_DATUM (fixnum))) 337 #define LONG_TO_UNSIGNED_FIXNUM_P(n) ((((unsigned long) (n)) & SIGN_MASK) == 0) 338 339 #define LONG_TO_UNSIGNED_FIXNUM(n) \ 340 (MAKE_OBJECT (TC_FIXNUM, ((unsigned long) (n)))) 341 342 #define LONG_TO_FIXNUM_P(n) \ 343 (((((unsigned long) (n)) & SIGN_MASK) == 0) \ 344 || ((((unsigned long) (n)) & SIGN_MASK) == SIGN_MASK)) 345 346 #define LONG_TO_FIXNUM(n) \ 347 (MAKE_OBJECT (TC_FIXNUM, (((unsigned long) (n)) & DATUM_MASK))) 348 349 #define FIXNUM_TO_LONG(fixnum) \ 350 ((long) \ 351 (((fixnum) ^ FIXNUM_SIGN_BIT) \ 352 - ((((unsigned long) TC_FIXNUM) << DATUM_LENGTH) | FIXNUM_SIGN_BIT))) 353 354 #define ULONG_TO_FIXNUM_P(n) (((n) & SIGN_MASK) == 0) 355 #define ULONG_TO_FIXNUM(n) (MAKE_OBJECT (TC_FIXNUM, (n))) 356 #define FIXNUM_TO_ULONG_P(fixnum) (((OBJECT_DATUM (fixnum)) & SIGN_MASK) == 0) 357 #define FIXNUM_TO_ULONG(fixnum) (OBJECT_DATUM (fixnum)) 358 359 #define FIXNUM_TO_DOUBLE(fixnum) ((double) (FIXNUM_TO_LONG (fixnum))) 360 361 #define DOUBLE_TO_FIXNUM_P(number) \ 362 (((number) > ((double) (SMALLEST_FIXNUM - 1))) \ 363 && ((number) < ((double) (BIGGEST_FIXNUM + 1)))) 364 365 #ifdef HAVE_DOUBLE_TO_LONG_BUG 366 # define DOUBLE_TO_FIXNUM double_to_fixnum 367 #else 368 # define DOUBLE_TO_FIXNUM(number) (LONG_TO_FIXNUM ((long) (number))) 369 #endif 370 371 /* Bignum Operations */ 372 373 #define BIGNUM_ZERO_P(bignum) \ 374 ((bignum_test (bignum)) == bignum_comparison_equal) 375 376 #define BIGNUM_NEGATIVE_P(bignum) \ 377 ((bignum_test (bignum)) == bignum_comparison_less) 378 379 #define BIGNUM_POSITIVE_P(bignum) \ 380 ((bignum_test (bignum)) == bignum_comparison_greater) 381 382 #define BIGNUM_LESS_P(x, y) \ 383 ((bignum_compare ((x), (y))) == bignum_comparison_less) 384 385 #define BIGNUM_TO_LONG_P(bignum) \ 386 (bignum_fits_in_word_p ((bignum), ((sizeof (long)) * CHAR_BIT), 1)) 387 388 #define BIGNUM_TO_ULONG_P(bignum) \ 389 (bignum_fits_in_word_p ((bignum), ((sizeof (unsigned long)) * CHAR_BIT), 0)) 390 391 #define BIGNUM_TO_INTMAX_P(bignum) \ 392 (bignum_fits_in_word_p ((bignum), ((sizeof (intmax_t)) * CHAR_BIT), 1)) 393 394 #define BIGNUM_TO_UINTMAX_P(bignum) \ 395 (bignum_fits_in_word_p ((bignum), ((sizeof (uintmax_t)) * CHAR_BIT), 0)) 396 397 #define BIGNUM_TO_DOUBLE_P(bignum) \ 398 (bignum_fits_in_word_p ((bignum), (DBL_MAX_EXP + 1), 1)) 399 400 #define LOSSLESS_BIGNUM_TO_DOUBLE_P(bignum) \ 401 (bignum_fits_in_word_p ((bignum), (DBL_MANT_DIG + 1), 1)) 402 403 /* Flonum Operations */ 404 405 #define FLONUM_SIZE (BYTES_TO_WORDS (sizeof (double))) 406 407 #define FLONUM_TO_DOUBLE(object) \ 408 (* ((double *) (MEMORY_LOC ((object), 1)))) 409 410 #define FLOAT_TO_FLONUM(expression) \ 411 (double_to_flonum ((double) (expression))) 412 413 #define FLONUM_TRUNCATE(object) \ 414 (double_to_flonum (double_truncate (FLONUM_TO_DOUBLE (object)))) 415 416 /* Flonum-vector Operations */ 417 418 #define FLOATING_VECTOR_LENGTH(vector) \ 419 ((VECTOR_LENGTH (vector)) / FLONUM_SIZE) 420 421 #define FLOATING_VECTOR_LOC(vector, index) \ 422 ((double *) (VECTOR_LOC ((vector), ((index) * FLONUM_SIZE)))) 423 424 #define FLOATING_VECTOR_REF(vector, index) \ 425 (* (FLOATING_VECTOR_LOC ((vector), (index)))) 426 427 #define FLOATING_VECTOR_SET(vector, index, x) \ 428 (* (FLOATING_VECTOR_LOC ((vector), (index)))) = ((double) (x)) 429 430 /* Numeric Type Conversions */ 431 432 #define BIGNUM_TO_FIXNUM_P(bignum) \ 433 (bignum_fits_in_word_p ((bignum), (FIXNUM_LENGTH + 1), 1)) 434 435 #define FIXNUM_TO_BIGNUM(fixnum) (long_to_bignum (FIXNUM_TO_LONG (fixnum))) 436 #define FIXNUM_TO_FLONUM(fixnum) (double_to_flonum (FIXNUM_TO_DOUBLE (fixnum))) 437 #define BIGNUM_TO_FIXNUM(bignum) (LONG_TO_FIXNUM (bignum_to_long (bignum))) 438 #define BIGNUM_TO_FLONUM_P BIGNUM_TO_DOUBLE_P 439 #define BIGNUM_TO_FLONUM(bignum) (double_to_flonum (bignum_to_double (bignum))) 440 #define FLONUM_TO_BIGNUM(flonum) (double_to_bignum (FLONUM_TO_DOUBLE (flonum))) 441 #define FLONUM_TO_INTEGER(x) (double_to_integer (FLONUM_TO_DOUBLE (x))) 442 #define INTEGER_TO_FLONUM_P integer_to_double_p 443 #define INTEGER_TO_FLONUM(n) (double_to_flonum (integer_to_double (n))) 444 445 #define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F) 446 #define OBJECT_TO_BOOLEAN(object) ((object) != SHARP_F) 447 448 #define MAKE_BROKEN_HEART(address) \ 449 (MAKE_POINTER_OBJECT (TC_BROKEN_HEART, (address))) 450 451 #define MAKE_RETURN_CODE(n) (MAKE_OBJECT (TC_RETURN_CODE, (n))) 452 453 #define BYTES_TO_WORDS(nbytes) \ 454 (((nbytes) + ((sizeof (SCHEME_OBJECT)) - 1)) / (sizeof (SCHEME_OBJECT))) 455 456 #define HEAP_ADDRESS_P(address) \ 457 (((address) >= heap_start) && ((address) < Free)) 458 459 #ifndef FLOATING_ALIGNMENT 460 # define FLOATING_ALIGNMENT 0 461 #endif 462 463 #define FLOATING_ALIGNED_P(ptr) \ 464 ((((unsigned long) ((ptr) + 1)) & FLOATING_ALIGNMENT) == 0) 465 466 #define ALIGN_FLOAT(loc) do \ 467 { \ 468 while (!FLOATING_ALIGNED_P (loc)) \ 469 (*(loc)++) = (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, 0)); \ 470 } while (0) 471 472 /* Assigned TC_CONSTANT datum values: 473 0 #t 474 1 unspecific 475 2 [non-object] 476 3 #!optional 477 4 #!rest 478 5 #!key 479 6 #!eof 480 7 #!default 481 8 #!aux 482 9 '() 483 */ 484 485 #define SHARP_F MAKE_OBJECT (TC_NULL, 0) 486 #define SHARP_T MAKE_OBJECT (TC_CONSTANT, 0) 487 #define UNSPECIFIC MAKE_OBJECT (TC_CONSTANT, 1) 488 #define DEFAULT_OBJECT MAKE_OBJECT (TC_CONSTANT, 7) 489 #define EMPTY_LIST MAKE_OBJECT (TC_CONSTANT, 9) 490 #define FIXNUM_ZERO MAKE_OBJECT (TC_FIXNUM, 0) 491 #define BROKEN_HEART_ZERO MAKE_OBJECT (TC_BROKEN_HEART, 0) 492 493 /* Last immediate reference trap. */ 494 #define TRAP_MAX_IMMEDIATE 9 495 496 #endif /* SCM_OBJECT_H */ 497