1 /* 2 * Part of Scheme 48 1.9. See file COPYING for notices and license. 3 * 4 * Authors: David Frese 5 */ 6 7 #ifndef __S48_GC_DATA_H 8 #define __S48_GC_DATA_H 9 10 #include "scheme48.h" 11 #include "memory.h" // s48_address 12 13 #define S48_UNSIGNED_HIGH_BITS(x, offset, len) ((((unsigned long)(x)) >> offset)\ 14 & ((1L << len) - 1)) 15 16 /* selecting/mutating fields of a header directly */ 17 18 #define S48_HEADER_LENGTH_IN_BYTES(h) ((unsigned long)(h) >> 8) 19 #define S48_HEADER_TYPE(h) S48_UNSIGNED_HIGH_BITS(h, 2, 5) 20 #define S48_HEADER_LENGTH_IN_CELLS(h) \ 21 S48_BYTES_TO_CELLS(S48_HEADER_LENGTH_IN_BYTES(h)) 22 #define S48_HEADER_LENGTH_IN_A_UNITS(h) \ 23 (S48_BYTES_TO_A_UNITS(S48_HEADER_LENGTH_IN_BYTES(h))) 24 #define S48_HEADER_IMMUTABLE_P(h) S48_UNSIGNED_HIGH_BITS(h, 7, 1) 25 26 #define S48_HEADER_MAKE_IMMUTABLE(h) ((h) |= (1L << 7)) 27 #define S48_HEADER_MAKE_MUTABLE(x) ((h) &= ~(1L << 7)) 28 29 #define S48_MAKE_HEADER(stobtype, size) ( (size << 8) | (stobtype << 2) | S48_HEADER_TAG ) 30 31 /* some type predicates */ 32 33 #define S48_LEAST_B_VECTOR_TYPE S48_STOBTYPE_STRING 34 #define S48_B_VECTOR_HEADER_P(h) \ 35 (S48_HEADER_TYPE(h) >= S48_LEAST_B_VECTOR_TYPE) 36 #define S48_D_VECTOR_HEADER_P(h) \ 37 (S48_HEADER_TYPE(h) < S48_LEAST_B_VECTOR_TYPE) 38 #define S48_CONTINUATION_HEADER_P(h) \ 39 (S48_HEADER_TYPE(h) == S48_STOBTYPE_CONTINUATION) 40 41 /* some other stob thing */ 42 43 #define S48_ADDRESS_TO_STOB_DESCRIPTOR(a) \ 44 ((s48_value)(((unsigned long)a) | S48_STOB_TAG)) 45 46 #define S48_STOB_OVERHEAD_IN_CELLS 1 47 #define S48_STOB_OVERHEAD_IN_BYTES \ 48 S48_CELLS_TO_BYTES(S48_STOB_OVERHEAD_IN_CELLS) 49 #define S48_STOB_OVERHEAD_IN_A_UNITS \ 50 S48_BYTES_TO_A_UNITS(S48_STOB_OVERHEAD_IN_BYTES) 51 52 /* repeated from scheme48.h because NO_OLD_FFI is defined sometimes (e.g. socket.c) */ 53 #ifndef S48_ADDRESS_AFTER_HEADER 54 #define S48_ADDRESS_AFTER_HEADER(x, type) ((type *)((x) - S48_STOB_TAG)) 55 #endif 56 #ifndef S48_STOB_TAG 57 #define S48_STOB_TAG 3 58 #endif 59 60 61 #define S48_ADDRESS_AT_HEADER(stob) \ 62 ((s48_address)(((unsigned long)S48_ADDRESS_AFTER_HEADER(stob, void))\ 63 - S48_STOB_OVERHEAD_IN_A_UNITS)) 64 65 #endif 66