1 /* This file was generated automatically. 2 It's probably not a good idea to change it. */ 3 4 #ifndef _H_SCHEME48 5 #define _H_SCHEME48 6 7 #include <scheme48arch.h> 8 9 #ifdef __cplusplus 10 extern "C" 11 { 12 #endif 13 14 /* 15 * Part of Scheme 48 1.9. See file COPYING for notices and license. 16 * 17 * Authors: Richard Kelsey, Jonathan Rees, Marcus Crestani, Mike 18 * Sperber, Michael Zabka, Harald Glab-Phlak 19 */ 20 21 #if defined HAVE_STDINT_H 22 #include <stdint.h> /* uintXX_t, C99 */ 23 #endif 24 25 #if defined HAVE_SYS_TYPES_H 26 #include <sys/types.h> /* size_t */ 27 #endif 28 29 typedef long s48_value; 30 31 #define NO_ERRORS 0 /* errno value */ 32 33 #if SIZEOF_VOID_P == 4 34 #define S48_MAX_FIXNUM_VALUE ((1 << 29) - 1) 35 #define S48_MIN_FIXNUM_VALUE (-1 << 29) 36 #define S48_LOG_BYTES_PER_CELL 2 37 #elif SIZEOF_VOID_P == 8 38 #define S48_MAX_FIXNUM_VALUE ((1L << 61) - 1) 39 #define S48_MIN_FIXNUM_VALUE (-1L << 61) 40 #define S48_LOG_BYTES_PER_CELL 3 41 #else 42 #error "What size are your pointers, really?" 43 #endif 44 45 46 /* New FFI */ 47 48 typedef struct s48_ref_s *s48_ref_t; 49 typedef struct s48_call_s *s48_call_t; 50 51 /* local refs */ 52 S48_EXTERN s48_ref_t s48_make_local_ref(s48_call_t call, s48_value obj); 53 S48_EXTERN s48_ref_t s48_copy_local_ref(s48_call_t call, s48_ref_t ref); 54 S48_EXTERN void s48_free_local_ref(s48_call_t call, s48_ref_t ref); 55 S48_EXTERN void s48_free_local_ref_array(s48_call_t call, s48_ref_t *refs, size_t len); 56 57 /* global refs */ 58 S48_EXTERN s48_ref_t s48_make_global_ref(s48_value obj); 59 S48_EXTERN void s48_free_global_ref(s48_ref_t ref); 60 S48_EXTERN s48_ref_t s48_local_to_global_ref(s48_ref_t ref); 61 62 /* local bufs */ 63 S48_EXTERN void *s48_make_local_buf (s48_call_t call, size_t s); 64 S48_EXTERN void s48_free_local_buf (s48_call_t call, void *buffer); 65 66 /* subcalls */ 67 S48_EXTERN s48_call_t s48_make_subcall(s48_call_t call); 68 S48_EXTERN void s48_free_subcall(s48_call_t subcall); 69 S48_EXTERN s48_ref_t s48_finish_subcall(s48_call_t call, s48_call_t subcall, s48_ref_t ref); 70 71 /* immediate refs */ 72 S48_EXTERN s48_ref_t s48_get_immediate_ref(long immediate_index); 73 74 /* external code should not use this, but might need to... */ 75 S48_EXTERN void s48_setref(s48_ref_t ref, s48_value obj); 76 S48_EXTERN s48_value s48_deref(s48_ref_t ref); 77 78 79 /* Misc stuff */ 80 81 #define s48_eq_p_2(c, r1, r2) (s48_deref(r1) == s48_deref(r2)) 82 /* Superceded name for the above definition, retained for compatibility. */ 83 #define s48_eq_2(c, r1, r2) (c, s48_deref(r1) == s48_deref(r2)) 84 85 S48_EXTERN int s48_stob_has_type_2(s48_call_t, s48_ref_t, int); 86 S48_EXTERN long s48_stob_length_2(s48_call_t, s48_ref_t, int); 87 S48_EXTERN long s48_stob_byte_length_2(s48_call_t, s48_ref_t, int); 88 S48_EXTERN s48_ref_t s48_stob_ref_2(s48_call_t, s48_ref_t, int, long); 89 S48_EXTERN void s48_stob_set_2(s48_call_t, s48_ref_t, int, long, s48_ref_t); 90 S48_EXTERN char s48_stob_byte_ref_2(s48_call_t, s48_ref_t, int, long); 91 S48_EXTERN void s48_stob_byte_set_2(s48_call_t, s48_ref_t, int, long, char); 92 93 S48_EXTERN s48_ref_t s48_make_string_2(s48_call_t, int, long); 94 S48_EXTERN void s48_string_set_2(s48_call_t, s48_ref_t s, long i, long c); 95 S48_EXTERN long s48_string_ref_2(s48_call_t, s48_ref_t s, long i); 96 S48_EXTERN long s48_string_length_2(s48_call_t, s48_ref_t s); 97 S48_EXTERN s48_ref_t s48_enter_string_latin_1_2(s48_call_t, const char* s); 98 S48_EXTERN s48_ref_t s48_enter_string_latin_1_n_2(s48_call_t, const char* s, long count); 99 S48_EXTERN long s48_string_latin_1_length_2(s48_call_t, s48_ref_t s); 100 S48_EXTERN long s48_string_latin_1_length_n_2(s48_call_t, s48_ref_t s, long start, long count); 101 S48_EXTERN void s48_copy_latin_1_to_string_2(s48_call_t, const char* s, s48_ref_t sch_s); 102 S48_EXTERN void s48_copy_latin_1_to_string_n_2(s48_call_t, const char* s, long len, s48_ref_t sch_s); 103 S48_EXTERN void s48_copy_string_to_latin_1_2(s48_call_t, s48_ref_t sch_s, char* s); 104 S48_EXTERN void s48_copy_string_to_latin_1_n_2(s48_call_t, s48_ref_t sch_s, long start, long count, char* s); 105 S48_EXTERN char * s48_extract_latin_1_from_string_2(s48_call_t, s48_ref_t); 106 S48_EXTERN s48_ref_t s48_enter_string_utf_8_2(s48_call_t, const char* s); 107 S48_EXTERN s48_ref_t s48_enter_string_utf_8_n_2(s48_call_t, const char* s, long count); 108 S48_EXTERN long s48_string_utf_8_length_2(s48_call_t, s48_ref_t s); 109 S48_EXTERN long s48_string_utf_8_length_n_2(s48_call_t, s48_ref_t s, long start, long count); 110 S48_EXTERN long s48_copy_string_to_utf_8_2(s48_call_t, s48_ref_t sch_s, char* s); 111 S48_EXTERN long s48_copy_string_to_utf_8_n_2(s48_call_t, s48_ref_t sch_s, long start, long count, char* s); 112 S48_EXTERN char * s48_extract_utf_8_from_string_2(s48_call_t, s48_ref_t); 113 S48_EXTERN s48_ref_t s48_enter_string_utf_16be_2(s48_call_t, const uint16_t *); 114 S48_EXTERN s48_ref_t s48_enter_string_utf_16be_n_2(s48_call_t, const uint16_t *, long); 115 S48_EXTERN long s48_string_utf_16be_length_2(s48_call_t, s48_ref_t); 116 S48_EXTERN long s48_string_utf_16be_length_n_2(s48_call_t, s48_ref_t, long, long); 117 S48_EXTERN uint16_t * s48_extract_utf_16be_from_string_2(s48_call_t, s48_ref_t); 118 S48_EXTERN s48_ref_t s48_enter_string_utf_16le_2(s48_call_t, const uint16_t *); 119 S48_EXTERN long s48_copy_string_to_utf_16be_2(s48_call_t, s48_ref_t, uint16_t *); 120 S48_EXTERN long s48_copy_string_to_utf_16be_n_2(s48_call_t, s48_ref_t, long, long, uint16_t *); 121 S48_EXTERN s48_ref_t s48_enter_string_utf_16le_n_2(s48_call_t, const uint16_t *, long); 122 S48_EXTERN long s48_string_utf_16le_length_2(s48_call_t, s48_ref_t); 123 S48_EXTERN long s48_string_utf_16le_length_n_2(s48_call_t, s48_ref_t, long, long); 124 S48_EXTERN long s48_copy_string_to_utf_16le_2(s48_call_t, s48_ref_t, uint16_t *); 125 S48_EXTERN long s48_copy_string_to_utf_16le_n_2(s48_call_t, s48_ref_t, long, long, uint16_t *); 126 S48_EXTERN uint16_t * s48_extract_utf_16le_from_string_2(s48_call_t, s48_ref_t); 127 128 S48_EXTERN s48_ref_t s48_enter_char_2(s48_call_t, long); 129 S48_EXTERN long s48_extract_char_2(s48_call_t, s48_ref_t); 130 S48_EXTERN s48_ref_t s48_enter_long_as_fixnum_2(s48_call_t, long); 131 S48_EXTERN s48_ref_t s48_enter_long_2(s48_call_t, long); 132 S48_EXTERN long s48_extract_long_2(s48_call_t, s48_ref_t); 133 S48_EXTERN s48_ref_t s48_enter_unsigned_long_2(s48_call_t, unsigned long); 134 S48_EXTERN unsigned long s48_extract_unsigned_long_2(s48_call_t, s48_ref_t); 135 S48_EXTERN s48_ref_t s48_enter_double_2(s48_call_t, double); 136 S48_EXTERN double s48_extract_double_2(s48_call_t, s48_ref_t); 137 138 S48_EXTERN s48_ref_t s48_cons_2(s48_call_t, s48_ref_t, s48_ref_t); 139 S48_EXTERN s48_ref_t s48_enter_byte_vector_2(s48_call_t, const char *, long); 140 S48_EXTERN s48_ref_t s48_enter_unmovable_byte_vector_2(s48_call_t, const char *, long); 141 S48_EXTERN char * s48_extract_byte_vector_2(s48_call_t, s48_ref_t); 142 S48_EXTERN char * s48_extract_byte_vector_readonly_2(s48_call_t, s48_ref_t); 143 S48_EXTERN char * s48_extract_unmovable_byte_vector_2(s48_call_t, s48_ref_t); 144 S48_EXTERN void s48_extract_byte_vector_region_2(s48_call_t, s48_ref_t, long, long, char*); 145 S48_EXTERN void s48_enter_byte_vector_region_2(s48_call_t, s48_ref_t, long, long, char*); 146 S48_EXTERN char * s48_extract_byte_vector_unmanaged_2(s48_call_t, s48_ref_t); 147 S48_EXTERN void s48_release_byte_vector_2(s48_call_t, s48_ref_t, char*); 148 S48_EXTERN void s48_copy_from_byte_vector_2(s48_call_t, s48_ref_t, char *); 149 S48_EXTERN void s48_copy_to_byte_vector_2(s48_call_t, s48_ref_t, char *); 150 S48_EXTERN s48_ref_t s48_make_vector_2(s48_call_t, long, s48_ref_t); 151 S48_EXTERN s48_ref_t s48_make_byte_vector_2(s48_call_t, long); 152 S48_EXTERN s48_ref_t s48_make_unmovable_byte_vector_2(s48_call_t, long); 153 S48_EXTERN s48_ref_t s48_enter_byte_string_2(s48_call_t, const char *); 154 S48_EXTERN s48_ref_t s48_enter_byte_substring_2(s48_call_t, const char *, long); 155 S48_EXTERN s48_ref_t s48_make_record_2(s48_call_t, s48_ref_t); 156 S48_EXTERN s48_ref_t s48_make_weak_pointer_2(s48_call_t, s48_ref_t); 157 S48_EXTERN void s48_check_record_type_2(s48_call_t, s48_ref_t, s48_ref_t); 158 S48_EXTERN s48_ref_t s48_length_2(s48_call_t, s48_ref_t); 159 160 S48_EXTERN s48_ref_t s48_enter_pointer_2(s48_call_t, void *); 161 S48_EXTERN void* s48_extract_pointer_2(s48_call_t, s48_ref_t); 162 S48_EXTERN s48_ref_t s48_get_imported_binding_2(char *); 163 S48_EXTERN s48_ref_t s48_get_imported_binding_local_2(s48_call_t, char *); 164 S48_EXTERN s48_ref_t s48_define_exported_binding_2(s48_call_t, char *, s48_ref_t); 165 166 S48_EXTERN s48_ref_t s48_set_channel_os_index_2(s48_call_t, s48_ref_t, long); 167 S48_EXTERN s48_ref_t s48_add_channel_2(s48_call_t, s48_ref_t, s48_ref_t, long); 168 S48_EXTERN void s48_close_channel_2(s48_call_t, long); 169 170 S48_EXTERN void s48_check_enum_set_type_2(s48_call_t, s48_ref_t, s48_ref_t); 171 S48_EXTERN long s48_enum_set2integer_2(s48_call_t, s48_ref_t); 172 S48_EXTERN s48_ref_t s48_integer2enum_set_2(s48_call_t, s48_ref_t, long); 173 174 S48_EXTERN s48_ref_t s48_call_scheme_2(s48_call_t call, s48_ref_t proc, long nargs, ...); 175 176 S48_EXTERN s48_ref_t s48_get_current_time(s48_call_t call); 177 S48_EXTERN s48_ref_t s48_get_timezone(s48_call_t call); 178 179 #define s48_make_value_2(c, type) (s48_make_byte_vector_2(c, sizeof(type))) 180 #define s48_make_sized_value_2(c, size) (s48_make_byte_vector_2(c, size)) 181 S48_EXTERN void * s48_value_pointer_2(s48_call_t, s48_ref_t); 182 183 #define s48_extract_value_pointer_2(c, x, type) ((type *) s48_value_pointer_2(c, x)) 184 #define s48_extract_value_2(c, x, type) (*(s48_extract_value_pointer_2(c, (x), type))) 185 #define s48_value_size_2(c, x) (s48_byte_vector_length_2(c, x)) 186 #define s48_set_value_2(c, x, type, v) (s48_extract_value_2(c, (x), type) = (v)) 187 188 #define s48_unsafe_extract_value_pointer_2(c, x, type) \ 189 (s48_address_after_header_2(c, (x), type)) 190 #define s48_unsafe_extract_value_2(c, x, type) \ 191 (*(s48_unsafe_extract_value_pointer_2(c, (x), type))) 192 #define s48_unsafe_set_value_2(c, x, type, v) \ 193 (s48_unsafe_extract_value_2(c, (x), type) = (v)) 194 195 #define s48_unsafe_extract_double_2(c, x) \ 196 (*(s48_address_after_header_2(c, (x), double))) 197 198 #define s48_arg_ref_2(c, argv, index, argc) ((argv)[(argc)-(index)-1]) 199 200 /* Exceptions */ 201 202 S48_EXTERN void s48_error_2(s48_call_t call, const char* who, const char* message, 203 long irritant_count, ...); 204 S48_EXTERN void s48_assertion_violation_2(s48_call_t call, const char* who, const char* message, 205 long irritant_count, ...); 206 S48_EXTERN void s48_os_error_2(s48_call_t call, const char* who, int the_errno, 207 long irritant_count, ...); 208 S48_EXTERN void s48_out_of_memory_error_2(s48_call_t call); 209 210 /* Internal use */ 211 212 S48_EXTERN void s48_raise_scheme_exception_2(s48_call_t call, long type, long nargs, ...); 213 214 /* Type checking */ 215 216 #define s48_check_pair_2(c, v) do { if (!s48_pair_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be a pair", 1, v); } while (0) 217 #define s48_check_fixnum_2(c, v) do { if (!s48_fixnum_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be a fixnum", 1, v); } while (0) 218 #define s48_check_string_2(c, v) do { if (!s48_string_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be a string", 1, v); } while (0) 219 #define s48_check_byte_vector_2(c, v) do { if (!s48_byte_vector_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be a bytevector", 1, v); } while (0) 220 #define s48_check_channel_2(c, v) do { if (!s48_channel_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be a channel", 1, v); } while (0) 221 #define s48_check_record_2(c, v) do { if (!s48_record_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be a record", 1, v); } while (0) 222 #define s48_check_value_2(c, v) do { if (!s48_byte_vector_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be an external value", 1, v); } while (0) 223 #define s48_check_export_binding_2(c, v) do { if (!s48_export_binding_p_2(c, v)) s48_assertion_violation_2(c, NULL, "must be an exported value", 1, v ); } while (0) 224 #define s48_check_boolean_2(c, v) \ 225 do { if (!s48_false_p_2(c, v) && !s48_true_p_2(c, v)) \ 226 s48_assertion_violation_2(c, NULL, "must be a boolean", 1, v); } while (0) 227 228 #define s48_value_p_2(c, v) (s48_byte_vector_p_2(c, v)) 229 230 #define s48_true_p_2(c, r) (s48_deref(r) == _s48_value_true) 231 #define s48_false_p_2(c, r) (s48_deref(r) == _s48_value_false) 232 #define s48_null_p_2(c, r) (s48_deref(r) == _s48_value_null) 233 #define s48_extract_boolean_2(c, r) (!(s48_deref(r) == _s48_value_false)) 234 #define s48_enter_boolean_2(c, v) ((v) ? s48_true_2(c) : s48_false_2(c)) 235 236 #define s48_shared_binding_check_2(c, binding) \ 237 do { if (s48_deref(s48_shared_binding_ref_2(c, binding)) == _s48_value_unspecific) \ 238 s48_raise_scheme_exception_2(c, s48_exception_unbound_external_name, 1, \ 239 s48_shared_binding_name_2(c, binding)); \ 240 } while(0) 241 242 243 244 #ifndef NO_OLD_FFI 245 246 /* Misc stuff */ 247 248 #define S48_EQ_P(v1, v2) ((v1) == (v2)) 249 /* Superceded name for the above definition, retained for compatibility. */ 250 #define S48_EQ(v1, v2) ((v1) == (v2)) 251 252 S48_EXTERN int s48_stob_has_type(s48_value, int); 253 S48_EXTERN long s48_stob_length(s48_value, int); 254 S48_EXTERN long s48_stob_byte_length(s48_value, int); 255 S48_EXTERN s48_value s48_stob_ref(s48_value, int, long); 256 S48_EXTERN void s48_stob_set(s48_value, int, long, s48_value); 257 S48_EXTERN char s48_stob_byte_ref(s48_value, int, long); 258 S48_EXTERN void s48_stob_byte_set(s48_value, int, long, char); 259 260 S48_EXTERN char * s48_register_gc_rootB(char *); 261 S48_EXTERN void s48_unregister_gc_rootB(char *); 262 S48_EXTERN void s48_push_gc_rootsB(char *, long); 263 S48_EXTERN char s48_pop_gc_rootsB(void); 264 265 S48_EXTERN s48_value s48_make_string(int, long); 266 S48_EXTERN void s48_string_set(s48_value s, long i, long c); 267 S48_EXTERN long s48_string_ref(s48_value s, long i); 268 S48_EXTERN long s48_string_length(s48_value s); 269 S48_EXTERN s48_value s48_enter_string_latin_1(char* s); 270 S48_EXTERN s48_value s48_enter_string_latin_1_n(char* s, long count); 271 S48_EXTERN void s48_copy_latin_1_to_string(char* s, s48_value sch_s); 272 S48_EXTERN void s48_copy_latin_1_to_string_n(char* s, long len, s48_value sch_s); 273 S48_EXTERN void s48_copy_string_to_latin_1(s48_value sch_s, char* s); 274 S48_EXTERN void s48_copy_string_to_latin_1_n(s48_value sch_s, long start, long count, char* s); 275 S48_EXTERN s48_value s48_enter_string_utf_8(char* s); 276 S48_EXTERN s48_value s48_enter_string_utf_8_n(char* s, long count); 277 S48_EXTERN long s48_string_utf_8_length(s48_value s); 278 S48_EXTERN long s48_string_utf_8_length_n(s48_value s, long start, long count); 279 S48_EXTERN long s48_copy_string_to_utf_8(s48_value sch_s, char* s); 280 S48_EXTERN long s48_copy_string_to_utf_8_n(s48_value sch_s, long start, long count, char* s); 281 S48_EXTERN s48_value s48_enter_string_utf_16be(const uint16_t *); 282 S48_EXTERN s48_value s48_enter_string_utf_16be_n(const uint16_t *, long); 283 S48_EXTERN long s48_string_utf_16be_length(s48_value); 284 S48_EXTERN long s48_string_utf_16be_length_n(s48_value, long, long); 285 S48_EXTERN long s48_copy_string_to_utf_16be(s48_value, uint16_t *); 286 S48_EXTERN long s48_copy_string_to_utf_16be_n(s48_value, long, long, uint16_t *); 287 S48_EXTERN s48_value s48_enter_string_utf_16le(const uint16_t *); 288 S48_EXTERN s48_value s48_enter_string_utf_16le_n(const uint16_t *, long); 289 S48_EXTERN long s48_string_utf_16le_length(s48_value); 290 S48_EXTERN long s48_string_utf_16le_length_n(s48_value, long, long); 291 S48_EXTERN long s48_copy_string_to_utf_16le(s48_value, uint16_t *); 292 S48_EXTERN long s48_copy_string_to_utf_16le_n(s48_value, long, long, uint16_t *); 293 294 S48_EXTERN s48_value s48_enter_char(long); 295 S48_EXTERN long s48_extract_char(s48_value); 296 S48_EXTERN s48_value s48_enter_fixnum(long); 297 S48_EXTERN long s48_extract_fixnum(s48_value); 298 S48_EXTERN s48_value s48_enter_integer(long); 299 S48_EXTERN long s48_extract_integer(s48_value); 300 S48_EXTERN s48_value s48_enter_unsigned_integer(unsigned long); 301 S48_EXTERN unsigned long s48_extract_unsigned_integer(s48_value); 302 S48_EXTERN s48_value s48_enter_double(double); 303 S48_EXTERN double s48_extract_double(s48_value); 304 305 S48_EXTERN s48_value s48_cons(s48_value, s48_value); 306 S48_EXTERN s48_value s48_enter_byte_vector(char *, long); 307 S48_EXTERN s48_value s48_enter_unmovable_byte_vector(char *, long); 308 S48_EXTERN char * s48_extract_byte_vector(s48_value); 309 S48_EXTERN s48_value s48_make_vector(long, s48_value); 310 S48_EXTERN s48_value s48_make_byte_vector(long); 311 S48_EXTERN s48_value s48_make_unmovable_byte_vector(long); 312 S48_EXTERN s48_value s48_enter_byte_string(char *); 313 S48_EXTERN s48_value s48_enter_byte_substring(char *, long); 314 S48_EXTERN s48_value s48_make_record(s48_value); 315 S48_EXTERN s48_value s48_make_weak_pointer(s48_value); 316 S48_EXTERN void s48_check_record_type(s48_value, s48_value); 317 S48_EXTERN s48_value s48_length(s48_value); 318 S48_EXTERN void* s48_extract_pointer(s48_value); 319 S48_EXTERN s48_value s48_get_imported_binding(char *); 320 321 S48_EXTERN s48_value s48_set_channel_os_index(s48_value, long); 322 S48_EXTERN s48_value s48_add_channel(s48_value, s48_value, long); 323 S48_EXTERN void s48_close_channel(long); 324 325 S48_EXTERN void s48_check_enum_set_type(s48_value, s48_value); 326 S48_EXTERN long s48_enum_set2integer(s48_value); 327 S48_EXTERN s48_value s48_integer2enum_set(s48_value, long); 328 329 S48_EXTERN s48_value s48_call_scheme(s48_value proc, long nargs, ...); 330 331 #define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type))) 332 #define S48_MAKE_SIZED_VALUE(size) (s48_make_byte_vector(size)) 333 S48_EXTERN void * s48_value_pointer(s48_value); 334 335 #define S48_EXTRACT_VALUE_POINTER(x, type) ((type *) s48_value_pointer(x)) 336 #define S48_EXTRACT_VALUE(x, type) (*(S48_EXTRACT_VALUE_POINTER((x), type))) 337 #define S48_VALUE_SIZE(x) (S48_BYTE_VECTOR_LENGTH(x)) 338 #define S48_SET_VALUE(x, type, v) (S48_EXTRACT_VALUE((x), type) = (v)) 339 340 #define S48_UNSAFE_EXTRACT_VALUE_POINTER(x, type) \ 341 (S48_ADDRESS_AFTER_HEADER((x), type)) 342 #define S48_UNSAFE_EXTRACT_VALUE(x, type) \ 343 (*(S48_UNSAFE_EXTRACT_VALUE_POINTER((x), type))) 344 #define S48_UNSAFE_SET_VALUE(x, type, v) \ 345 (S48_UNSAFE_EXTRACT_VALUE((x), type) = (v)) 346 347 #define S48_UNSAFE_EXTRACT_DOUBLE(x) \ 348 (*(S48_ADDRESS_AFTER_HEADER((x), double))) 349 350 #define S48_ARG_REF(argv, index, argc) ((argv)[(argc)-(index)-1]) 351 352 #define S48_DECLARE_GC_PROTECT(n) long ___gc_buffer[(n)+2] 353 354 #define S48_GC_PROTECT_1(v) \ 355 (___gc_buffer[2]=(long)&(v), \ 356 s48_push_gc_rootsB((char *) ___gc_buffer, 1)) 357 358 #define S48_GC_PROTECT_2(v1, v2) \ 359 (___gc_buffer[2]=(long)&(v1), ___gc_buffer[3]=(long)&(v2), \ 360 s48_push_gc_rootsB((char *) ___gc_buffer, 2)) 361 362 #define S48_GC_PROTECT_3(v1, v2, v3) \ 363 (___gc_buffer[2]=(long)&(v1), \ 364 ___gc_buffer[3]=(long)&(v2), \ 365 ___gc_buffer[4]=(long)&(v3), \ 366 s48_push_gc_rootsB((char *) ___gc_buffer, 3)) 367 368 #define S48_GC_PROTECT_4(v1, v2, v3, v4) \ 369 (___gc_buffer[2]=(long)&(v1), \ 370 ___gc_buffer[3]=(long)&(v2), \ 371 ___gc_buffer[4]=(long)&(v3), \ 372 ___gc_buffer[5]=(long)&(v4), \ 373 s48_push_gc_rootsB((char *) ___gc_buffer, 4)) 374 375 #define S48_GC_PROTECT_5(v1, v2, v3, v4, v5) \ 376 (___gc_buffer[2]=(long)&(v1), \ 377 ___gc_buffer[3]=(long)&(v2), \ 378 ___gc_buffer[4]=(long)&(v3), \ 379 ___gc_buffer[5]=(long)&(v4), \ 380 ___gc_buffer[6]=(long)&(v5), \ 381 s48_push_gc_rootsB((char *) ___gc_buffer, 5)) 382 383 #define S48_GC_PROTECT_6(v1, v2, v3, v4, v5, v6) \ 384 (___gc_buffer[2]=(long)&(v1), \ 385 ___gc_buffer[3]=(long)&(v2), \ 386 ___gc_buffer[4]=(long)&(v3), \ 387 ___gc_buffer[5]=(long)&(v4), \ 388 ___gc_buffer[6]=(long)&(v5), \ 389 ___gc_buffer[7]=(long)&(v6), \ 390 s48_push_gc_rootsB((char *) ___gc_buffer, 6)) 391 392 #define S48_GC_PROTECT_7(v1, v2, v3, v4, v5, v6, v7) \ 393 (___gc_buffer[2]=(long)&(v1), \ 394 ___gc_buffer[3]=(long)&(v2), \ 395 ___gc_buffer[4]=(long)&(v3), \ 396 ___gc_buffer[5]=(long)&(v4), \ 397 ___gc_buffer[6]=(long)&(v5), \ 398 ___gc_buffer[7]=(long)&(v6), \ 399 ___gc_buffer[8]=(long)&(v7), \ 400 s48_push_gc_rootsB((char *) ___gc_buffer, 7)) 401 402 #define S48_GC_PROTECT_8(v1, v2, v3, v4, v5, v6, v7, v8) \ 403 (___gc_buffer[2]=(long)&(v1), \ 404 ___gc_buffer[3]=(long)&(v2), \ 405 ___gc_buffer[4]=(long)&(v3), \ 406 ___gc_buffer[5]=(long)&(v4), \ 407 ___gc_buffer[6]=(long)&(v5), \ 408 ___gc_buffer[7]=(long)&(v6), \ 409 ___gc_buffer[8]=(long)&(v7), \ 410 ___gc_buffer[9]=(long)&(v8), \ 411 s48_push_gc_rootsB((char *) ___gc_buffer, 8)) 412 413 #define S48_GC_PROTECT_9(v1, v2, v3, v4, v5, v6, v7, v8, v9) \ 414 (___gc_buffer[2]=(long)&(v1), \ 415 ___gc_buffer[3]=(long)&(v2), \ 416 ___gc_buffer[4]=(long)&(v3), \ 417 ___gc_buffer[5]=(long)&(v4), \ 418 ___gc_buffer[6]=(long)&(v5), \ 419 ___gc_buffer[7]=(long)&(v6), \ 420 ___gc_buffer[8]=(long)&(v7), \ 421 ___gc_buffer[9]=(long)&(v8), \ 422 ___gc_buffer[10]=(long)&(v9), \ 423 s48_push_gc_rootsB((char *) ___gc_buffer, 9)) 424 425 #define S48_GC_PROTECT_10(v1, v2, v3, v4, v5, v6, v7, v8, v9, v10) \ 426 (___gc_buffer[2]=(long)&(v1), \ 427 ___gc_buffer[3]=(long)&(v2), \ 428 ___gc_buffer[4]=(long)&(v3), \ 429 ___gc_buffer[5]=(long)&(v4), \ 430 ___gc_buffer[6]=(long)&(v5), \ 431 ___gc_buffer[7]=(long)&(v6), \ 432 ___gc_buffer[8]=(long)&(v7), \ 433 ___gc_buffer[9]=(long)&(v8), \ 434 ___gc_buffer[10]=(long)&(v9), \ 435 ___gc_buffer[11]=(long)&(v10), \ 436 s48_push_gc_rootsB((char *) ___gc_buffer, 10)) 437 438 #define S48_GC_UNPROTECT() \ 439 do { if (! s48_pop_gc_rootsB()) \ 440 s48_raise_scheme_exception( S48_EXCEPTION_GC_PROTECTION_MISMATCH, 0); \ 441 } while(0) 442 443 #define S48_GC_PROTECT_GLOBAL(v) ((void*)(s48_register_gc_rootB((char *)&(v)))) 444 #define S48_GC_UNPROTECT_GLOBAL(f) (s48_unregister_gc_rootB((char *)(f))) 445 446 /* Exceptions */ 447 448 S48_EXTERN void s48_error(const char* who, const char* message, 449 long irritant_count, ...); 450 S48_EXTERN void s48_assertion_violation(const char* who, const char* message, 451 long irritant_count, ...); 452 S48_EXTERN void s48_os_error(const char* who, int the_errno, 453 long irritant_count, ...); 454 S48_EXTERN void s48_out_of_memory_error(); 455 456 /* The following are deprecated */ 457 458 S48_EXTERN void s48_raise_argument_type_error(s48_value value); 459 S48_EXTERN void s48_raise_argument_number_error(s48_value value, 460 s48_value min, 461 s48_value max); 462 S48_EXTERN void s48_raise_range_error(s48_value value, 463 s48_value min, 464 s48_value max); 465 S48_EXTERN void s48_raise_closed_channel_error(); 466 S48_EXTERN void s48_raise_os_error(int the_errno); 467 S48_EXTERN void s48_raise_string_os_error(char *reason); 468 S48_EXTERN void s48_raise_out_of_memory_error(); 469 470 /* Internal use */ 471 472 S48_EXTERN void s48_raise_scheme_exception(long type, long nargs, ...); 473 474 /* Type checking */ 475 476 #define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_assertion_violation(NULL, "must be a pair", 1, v); } while (0) 477 #define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_assertion_violation(NULL, "must be a fixnum", 1, v); } while (0) 478 #define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_assertion_violation(NULL, "must be a string", 1, v); } while (0) 479 #define S48_CHECK_BYTE_VECTOR(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_assertion_violation(NULL, "must be a bytevector", 1, v); } while (0) 480 #define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_assertion_violation(NULL, "must be a channel", 1, v); } while (0) 481 #define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_assertion_violation(NULL, "must be a record", 1, v); } while (0) 482 #define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_assertion_violation(NULL, "must be an external value", 1, v); } while (0) 483 #define S48_CHECK_EXPORT_BINDING(v) do { if (!S48_EXPORT_BINDING_P(v)) s48_assertion_violation(NULL, "must be an exported value", 1, v ); } while (0) 484 #define S48_CHECK_BOOLEAN(v) \ 485 do { s48_value s48_temp = (v); \ 486 if (s48_temp != S48_TRUE && s48_temp != S48_FALSE) \ 487 s48_assertion_violation(NULL, "must be a boolean", 1, v); } while (0) 488 489 #define S48_VALUE_P(v) (S48_BYTE_VECTOR_P(v)) 490 491 #define S48_TRUE_P(v) ((v) == S48_TRUE) 492 #define S48_FALSE_P(v) ((v) == S48_FALSE) 493 #define S48_NULL_P(v) ((v) == S48_NULL) 494 #define S48_EXTRACT_BOOLEAN(v) ((v) != S48_FALSE) 495 #define S48_ENTER_BOOLEAN(v) ((v) ? S48_TRUE : S48_FALSE) 496 497 #define S48_SHARED_BINDING_CHECK(binding) \ 498 do { if (S48_UNSPECIFIC == S48_SHARED_BINDING_REF(binding)) \ 499 s48_raise_scheme_exception(S48_EXCEPTION_UNBOUND_EXTERNAL_NAME, 1, \ 500 S48_SHARED_BINDING_NAME(binding)); \ 501 } while(0) 502 503 #endif /* !NO_OLD_FFI */ 504 505 506 507 /* both */ 508 509 S48_EXTERN s48_value s48_define_exported_binding(char *, s48_value); 510 S48_EXTERN s48_value s48_enter_pointer(void *); 511 512 #define S48_EXPORT_FUNCTION(p) (s48_define_exported_binding(#p, s48_enter_pointer((void*) p))) 513 #define s48_export_function(p) S48_EXPORT_FUNCTION(p) 514 515 S48_EXTERN void s48_note_external_event(long); 516 517 518 /* New FFI */ 519 520 #define s48_fixnum_tag 0 521 #define s48_fixnum_p_2(c,x) (((long)s48_deref(x) & 3L) == s48_fixnum_tag) 522 #define s48_immediate_tag 1 523 #define s48_immediate_p_2(c,x) (((long)s48_deref(x) & 3L) == s48_immediate_tag) 524 #define s48_header_tag 2 525 #define s48_header_p_2(c,x) (((long)s48_deref(x) & 3L) == s48_header_tag) 526 #define s48_stob_tag 3 527 #define s48_stob_p_2(c,x) (((long)s48_deref(x) & 3L) == s48_stob_tag) 528 #if defined(S48_GC_BIBOP) && defined(NO_OLD_FFI) 529 #define S48_STOB_P(x) (((long)(x) & 3L) == s48_stob_tag) 530 #endif 531 532 #define s48_unsafe_enter_long_as_fixnum_2(c, n) (s48_make_local_ref(c,(s48_value)((n) << 2))) 533 #define s48_unsafe_extract_long_2(c, x) ((long)s48_deref(x) >> 2) 534 535 #define MISC_IMMEDIATE_INTERNAL_2(n) (s48_immediate_tag | ((n) << 2)) 536 #define _s48_value_false MISC_IMMEDIATE_INTERNAL_2(0) 537 #define s48_false_2(c) s48_make_local_ref(c, _s48_value_false) 538 #define _s48_value_true MISC_IMMEDIATE_INTERNAL_2(1) 539 #define s48_true_2(c) s48_make_local_ref(c, _s48_value_true) 540 #define _s48_value_char MISC_IMMEDIATE_INTERNAL_2(2) 541 #define s48_char_2(c) s48_make_local_ref(c, _s48_value_char) 542 #define _s48_value_unspecific MISC_IMMEDIATE_INTERNAL_2(3) 543 #define s48_unspecific_2(c) s48_make_local_ref(c, _s48_value_unspecific) 544 #define _s48_value_undefined MISC_IMMEDIATE_INTERNAL_2(4) 545 #define s48_undefined_2(c) s48_make_local_ref(c, _s48_value_undefined) 546 #define _s48_value_eof MISC_IMMEDIATE_INTERNAL_2(5) 547 #define s48_eof_2(c) s48_make_local_ref(c, _s48_value_eof) 548 #define _s48_value_null MISC_IMMEDIATE_INTERNAL_2(6) 549 #define s48_null_2(c) s48_make_local_ref(c, _s48_value_null) 550 #define _s48_value_unreleased MISC_IMMEDIATE_INTERNAL_2(7) 551 #define s48_unreleased_2(c) s48_make_local_ref(c, _s48_value_unreleased) 552 553 #define s48_unsafe_enter_char_2(call, c) s48_make_local_ref (call, _s48_value_char | ((c) << 8)) 554 #define s48_unsafe_extract_char_2(c,x) ((long)(s48_deref(x) >> 8)) 555 #define s48_char_p_2(c, x) ((((long) s48_deref(x)) & 0xff) == _s48_value_char) 556 557 #define ADDRESS_AFTER_HEADER_INTERNAL_2(x, type) ((type *)((x) - s48_stob_tag)) 558 #define STOB_REF_INTERNAL_2(x, i) ADDRESS_AFTER_HEADER_INTERNAL_2(x, s48_value)[i] 559 #define STOB_BYTE_REF_INTERNAL_2(x, i) (((char *) ADDRESS_AFTER_HEADER_INTERNAL_2(x, s48_value))[i]) 560 #define s48_address_after_header_2(c, x, type) ADDRESS_AFTER_HEADER_INTERNAL_2(s48_deref(x), type) 561 #define s48_unsafe_stob_ref_2(c, x, i) s48_make_local_ref(c, (STOB_REF_INTERNAL_2(s48_deref(x), i))) 562 #define s48_unsafe_stob_byte_ref_2(c, x, i) STOB_BYTE_REF_INTERNAL_2(s48_deref(x), i) 563 #define s48_unsafe_stob_set_2(c, x, i, r) do { s48_ref_t __stob_set_x_ref = (x); s48_ref_t __stob_set_r_ref = (r); long __stob_set_i = (i); s48_value __stob_set_x = s48_deref(__stob_set_x_ref); s48_value __stob_set_v = s48_deref(__stob_set_r_ref); if (s48_stob_immutablep_2(c, (x))) s48_assertion_violation_2(c, NULL, "immutable stob", 1, __stob_set_x); else { S48_WRITE_BARRIER((__stob_set_x), (char *) (&(STOB_REF_INTERNAL_2((__stob_set_x), (__stob_set_i)))),(__stob_set_v)); *(&STOB_REF_INTERNAL_2((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } } while (0) 564 #define s48_unsafe_stob_byte_set_2(c, x, i, v) do { long __stob_set_i = (i); char __stob_set_v = (v); s48_value __stob_set_x = s48_deref(x); if (s48_stob_immutablep_2(c, (x))) s48_assertion_violation(NULL, "immutable stob", 1, __stob_set_x); else *(&STOB_BYTE_REF_INTERNAL_2((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } while (0) 565 #define s48_stob_header_2(c, x) (STOB_REF_INTERNAL_2(s48_deref(x), -1)) 566 #define s48_stob_type_2(c, x) ((s48_stob_header_2(c, x)>>2)&31) 567 #define s48_stob_address_2(c, x) (&(s48_stob_header_2(c, x))) 568 #define s48_unsafe_stob_byte_length_2(c, x) (s48_stob_header_2(c, x) >> 8) 569 #define s48_unsafe_stob_descriptor_length_2(c, x) (s48_unsafe_stob_byte_length_2(c, x) >> S48_LOG_BYTES_PER_CELL) 570 #define s48_stob_immutablep_2(c, x) ((s48_stob_header_2(c, x)>>7) & 1) 571 #define s48_stob_make_immutable_2(c, x) ((s48_stob_header_2(c, x)) |= (1<<7)) 572 573 #define s48_stobtype_pair 0 574 #define s48_pair_p_2(c, x) (s48_stob_has_type_2(c, x, 0)) 575 #define s48_stobtype_symbol 1 576 #define s48_symbol_p_2(c, x) (s48_stob_has_type_2(c, x, 1)) 577 #define s48_stobtype_vector 2 578 #define s48_vector_p_2(c, x) (s48_stob_has_type_2(c, x, 2)) 579 #define s48_stobtype_closure 3 580 #define s48_closure_p_2(c, x) (s48_stob_has_type_2(c, x, 3)) 581 #define s48_stobtype_location 4 582 #define s48_location_p_2(c, x) (s48_stob_has_type_2(c, x, 4)) 583 #define s48_stobtype_cell 5 584 #define s48_cell_p_2(c, x) (s48_stob_has_type_2(c, x, 5)) 585 #define s48_stobtype_channel 6 586 #define s48_channel_p_2(c, x) (s48_stob_has_type_2(c, x, 6)) 587 #define s48_stobtype_port 7 588 #define s48_port_p_2(c, x) (s48_stob_has_type_2(c, x, 7)) 589 #define s48_stobtype_ratnum 8 590 #define s48_ratnum_p_2(c, x) (s48_stob_has_type_2(c, x, 8)) 591 #define s48_stobtype_record 9 592 #define s48_record_p_2(c, x) (s48_stob_has_type_2(c, x, 9)) 593 #define s48_stobtype_continuation 10 594 #define s48_continuation_p_2(c, x) (s48_stob_has_type_2(c, x, 10)) 595 #define s48_stobtype_extended_number 11 596 #define s48_extended_number_p_2(c, x) (s48_stob_has_type_2(c, x, 11)) 597 #define s48_stobtype_template 12 598 #define s48_template_p_2(c, x) (s48_stob_has_type_2(c, x, 12)) 599 #define s48_stobtype_weak_pointer 13 600 #define s48_weak_pointer_p_2(c, x) (s48_stob_has_type_2(c, x, 13)) 601 #define s48_stobtype_shared_binding 14 602 #define s48_shared_binding_p_2(c, x) (s48_stob_has_type_2(c, x, 14)) 603 #define s48_stobtype_transport_link_cell 15 604 #define s48_transport_link_cell_p_2(c, x) (s48_stob_has_type_2(c, x, 15)) 605 #define s48_stobtype_string 16 606 #define s48_string_p_2(c, x) (s48_stob_has_type_2(c, x, 16)) 607 #define s48_stobtype_byte_vector 17 608 #define s48_byte_vector_p_2(c, x) (s48_stob_has_type_2(c, x, 17)) 609 #define s48_stobtype_double 18 610 #define s48_double_p_2(c, x) (s48_stob_has_type_2(c, x, 18)) 611 #define s48_stobtype_bignum 19 612 #define s48_bignum_p_2(c, x) (s48_stob_has_type_2(c, x, 19)) 613 614 #define s48_car_offset 0 615 #define s48_car_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_pair, 0)) 616 #define s48_unsafe_car_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 617 #define s48_set_car_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_pair, 0, (r))) 618 #define s48_unsafe_set_car_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 0, (r)) 619 #define s48_cdr_offset 1 620 #define s48_cdr_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_pair, 1)) 621 #define s48_unsafe_cdr_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 1)) 622 #define s48_set_cdr_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_pair, 1, (r))) 623 #define s48_unsafe_set_cdr_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 1, (r)) 624 #define s48_symbol_to_string_offset 0 625 #define s48_symbol_to_string_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_symbol, 0)) 626 #define s48_unsafe_symbol_to_string_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 627 #define s48_location_id_offset 0 628 #define s48_location_id_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_location, 0)) 629 #define s48_unsafe_location_id_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 630 #define s48_set_location_id_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_location, 0, (r))) 631 #define s48_unsafe_set_location_id_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 0, (r)) 632 #define s48_contents_offset 1 633 #define s48_contents_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_location, 1)) 634 #define s48_unsafe_contents_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 1)) 635 #define s48_set_contents_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_location, 1, (r))) 636 #define s48_unsafe_set_contents_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 1, (r)) 637 #define s48_cell_ref_offset 0 638 #define s48_cell_ref_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_cell, 0)) 639 #define s48_unsafe_cell_ref_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 640 #define s48_cell_set_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_cell, 0, (r))) 641 #define s48_unsafe_cell_set_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 0, (r)) 642 #define s48_closure_template_offset 0 643 #define s48_closure_template_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_closure, 0)) 644 #define s48_unsafe_closure_template_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 645 #define s48_set_closure_template_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_closure, 0, (r))) 646 #define s48_unsafe_set_closure_template_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 0, (r)) 647 #define s48_closure_env_offset 1 648 #define s48_closure_env_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_closure, 1)) 649 #define s48_unsafe_closure_env_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 1)) 650 #define s48_set_closure_env_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_closure, 1, (r))) 651 #define s48_unsafe_set_closure_env_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 1, (r)) 652 #define s48_weak_pointer_ref_offset 0 653 #define s48_weak_pointer_ref_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_weak_pointer, 0)) 654 #define s48_unsafe_weak_pointer_ref_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 655 #define s48_shared_binding_name_offset 0 656 #define s48_shared_binding_name_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_shared_binding, 0)) 657 #define s48_unsafe_shared_binding_name_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 658 #define s48_shared_binding_is_importp_offset 1 659 #define s48_shared_binding_is_importp_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_shared_binding, 1)) 660 #define s48_unsafe_shared_binding_is_importp_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 1)) 661 #define s48_shared_binding_ref_offset 2 662 #define s48_shared_binding_ref_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_shared_binding, 2)) 663 #define s48_unsafe_shared_binding_ref_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 2)) 664 #define s48_shared_binding_set_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_shared_binding, 2, (r))) 665 #define s48_unsafe_shared_binding_set_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 2, (r)) 666 #define s48_port_handler_offset 0 667 #define s48_port_handler_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 0)) 668 #define s48_unsafe_port_handler_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 669 #define s48_port_text_codec_spec_offset 1 670 #define s48_port_text_codec_spec_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 1)) 671 #define s48_unsafe_port_text_codec_spec_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 1)) 672 #define s48_set_port_text_codec_spec_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 1, (r))) 673 #define s48_unsafe_set_port_text_codec_spec_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 1, (r)) 674 #define s48_port_crlfp_offset 2 675 #define s48_port_crlfp_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 2)) 676 #define s48_unsafe_port_crlfp_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 2)) 677 #define s48_set_port_crlfp_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 2, (r))) 678 #define s48_unsafe_set_port_crlfp_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 2, (r)) 679 #define s48_port_status_offset 3 680 #define s48_port_status_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 3)) 681 #define s48_unsafe_port_status_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 3)) 682 #define s48_set_port_status_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 3, (r))) 683 #define s48_unsafe_set_port_status_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 3, (r)) 684 #define s48_port_lock_offset 4 685 #define s48_port_lock_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 4)) 686 #define s48_unsafe_port_lock_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 4)) 687 #define s48_set_port_lock_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 4, (r))) 688 #define s48_unsafe_set_port_lock_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 4, (r)) 689 #define s48_port_data_offset 5 690 #define s48_port_data_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 5)) 691 #define s48_unsafe_port_data_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 5)) 692 #define s48_set_port_data_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 5, (r))) 693 #define s48_unsafe_set_port_data_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 5, (r)) 694 #define s48_port_buffer_offset 6 695 #define s48_port_buffer_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 6)) 696 #define s48_unsafe_port_buffer_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 6)) 697 #define s48_set_port_buffer_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 6, (r))) 698 #define s48_unsafe_set_port_buffer_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 6, (r)) 699 #define s48_port_index_offset 7 700 #define s48_port_index_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 7)) 701 #define s48_unsafe_port_index_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 7)) 702 #define s48_set_port_index_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 7, (r))) 703 #define s48_unsafe_set_port_index_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 7, (r)) 704 #define s48_port_limit_offset 8 705 #define s48_port_limit_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 8)) 706 #define s48_unsafe_port_limit_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 8)) 707 #define s48_set_port_limit_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 8, (r))) 708 #define s48_unsafe_set_port_limit_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 8, (r)) 709 #define s48_port_pending_crp_offset 9 710 #define s48_port_pending_crp_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 9)) 711 #define s48_unsafe_port_pending_crp_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 9)) 712 #define s48_set_port_pending_crp_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 9, (r))) 713 #define s48_unsafe_set_port_pending_crp_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 9, (r)) 714 #define s48_port_pending_eofp_offset 10 715 #define s48_port_pending_eofp_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_port, 10)) 716 #define s48_unsafe_port_pending_eofp_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 10)) 717 #define s48_set_port_pending_eofp_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_port, 10, (r))) 718 #define s48_unsafe_set_port_pending_eofp_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 10, (r)) 719 #define s48_channel_status_offset 0 720 #define s48_channel_status_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_channel, 0)) 721 #define s48_unsafe_channel_status_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 722 #define s48_channel_id_offset 1 723 #define s48_channel_id_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_channel, 1)) 724 #define s48_unsafe_channel_id_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 1)) 725 #define s48_channel_os_index_offset 2 726 #define s48_channel_os_index_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_channel, 2)) 727 #define s48_unsafe_channel_os_index_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 2)) 728 #define s48_channel_close_silentlyp_offset 3 729 #define s48_channel_close_silentlyp_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_channel, 3)) 730 #define s48_unsafe_channel_close_silentlyp_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 3)) 731 #define s48_transport_link_cell_key_offset 0 732 #define s48_transport_link_cell_key_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_transport_link_cell, 0)) 733 #define s48_unsafe_transport_link_cell_key_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 734 #define s48_transport_link_cell_value_offset 1 735 #define s48_transport_link_cell_value_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_transport_link_cell, 1)) 736 #define s48_unsafe_transport_link_cell_value_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 1)) 737 #define s48_set_transport_link_cell_value_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_transport_link_cell, 1, (r))) 738 #define s48_unsafe_set_transport_link_cell_value_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 1, (r)) 739 #define s48_transport_link_cell_tconc_offset 2 740 #define s48_transport_link_cell_tconc_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_transport_link_cell, 2)) 741 #define s48_unsafe_transport_link_cell_tconc_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 2)) 742 #define s48_set_transport_link_cell_tconc_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_transport_link_cell, 2, (r))) 743 #define s48_unsafe_set_transport_link_cell_tconc_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 2, (r)) 744 #define s48_transport_link_cell_next_offset 3 745 #define s48_transport_link_cell_next_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_transport_link_cell, 3)) 746 #define s48_unsafe_transport_link_cell_next_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 3)) 747 #define s48_set_transport_link_cell_next_2(c, x, r) (s48_stob_set_2(c, (x), s48_stobtype_transport_link_cell, 3, (r))) 748 #define s48_unsafe_set_transport_link_cell_next_2(c, x, r) s48_unsafe_stob_set_2(c, (x), 3, (r)) 749 750 #define s48_vector_length_2(c, x) (s48_stob_length_2(c, (x), s48_stobtype_vector)) 751 #define s48_unsafe_vector_length_2(c, x) (s48_unsafe_stob_descriptor_length_2(c, x)) 752 #define s48_unsafe_vector_ref_2(c, x, i) (s48_unsafe_stob_ref_2(c, (x), (i))) 753 #define s48_unsafe_vector_set_2(c, x, i, r) s48_unsafe_stob_set_2(c, (x), (i), (r)) 754 #define s48_vector_ref_2(c, x, i) (s48_stob_ref_2(c, (x), s48_stobtype_vector, (i))) 755 #define s48_vector_set_2(c, x, i, r) s48_stob_set_2(c, (x), s48_stobtype_vector, (i), (r)) 756 #define s48_record_length_2(c, x) (s48_stob_length_2(c, (x), s48_stobtype_record)) 757 #define s48_unsafe_record_length_2(c, x) (s48_unsafe_stob_descriptor_length_2(c, x)) 758 #define s48_unsafe_record_ref_2(c, x, i) (s48_unsafe_stob_ref_2(c, (x), (i) + 1)) 759 #define s48_unsafe_record_set_2(c, x, i, r) s48_unsafe_stob_set_2(c, (x), (i) + 1, (r)) 760 #define s48_record_ref_2(c, x, i) (s48_stob_ref_2(c, (x), s48_stobtype_record, (i) + 1)) 761 #define s48_record_set_2(c, x, i, r) s48_stob_set_2(c, (x), s48_stobtype_record, (i) + 1, (r)) 762 #define s48_record_type_2(c, x) (s48_stob_ref_2(c, (x), s48_stobtype_record, 0)) 763 #define s48_unsafe_record_type_2(c, x) (s48_unsafe_stob_ref_2(c, (x), 0)) 764 #define s48_byte_vector_length_2(c, x) (s48_stob_byte_length_2(c, (x), s48_stobtype_byte_vector)) 765 #define s48_byte_vector_ref_2(c, x, i) (s48_stob_byte_ref_2(c, (x), s48_stobtype_byte_vector, (i))) 766 #define s48_byte_vector_set_2(c, x, i, v) (s48_stob_byte_set_2(c, (x), s48_stobtype_byte_vector, (i), (v))) 767 #define s48_unsafe_byte_vector_length_2(c, x) (s48_unsafe_stob_byte_length_2(c, (x), s48_stobtype_byte_vector)) 768 #define s48_unsafe_byte_vector_ref_2(c, x, i) (s48_stob_byte_ref_2(c, (x), s48_stobtype_byte_vector, (i))) 769 #define s48_unsafe_byte_vector_set_2(c, x, i, v) (s48_stob_byte_set_2(c, (x), s48_stobtype_byte_vector, (i), (v))) 770 #define s48_unsafe_extract_byte_vector_2(c, x) (s48_address_after_header_2(c, (x), char)) 771 #define s48_extract_external_object_2(c, x, type) ((type *)(s48_address_after_header_2(c, x, long)+1)) 772 773 #define s48_record_type_resumer_2(c, x) s48_unsafe_record_ref_2(c, (x), 0) 774 #define s48_record_type_uid_2(c, x) s48_unsafe_record_ref_2(c, (x), 1) 775 #define s48_record_type_name_2(c, x) s48_unsafe_record_ref_2(c, (x), 2) 776 #define s48_record_type_field_names_2(c, x) s48_unsafe_record_ref_2(c, (x), 3) 777 #define s48_record_type_number_of_fields_2(c, x) s48_unsafe_record_ref_2(c, (x), 4) 778 #define s48_record_type_discloser_2(c, x) s48_unsafe_record_ref_2(c, (x), 5) 779 #define s48_record_type_parent_2(c, x) s48_unsafe_record_ref_2(c, (x), 6) 780 #define s48_record_type_extension_count_2(c, x) s48_unsafe_record_ref_2(c, (x), 7) 781 #define s48_record_type_size_2(c, x) s48_unsafe_record_ref_2(c, (x), 8) 782 #define s48_record_type_data_2(c, x) s48_unsafe_record_ref_2(c, (x), 9) 783 #define s48_record_type_base_2(c, x) s48_unsafe_record_ref_2(c, (x), 10) 784 785 #define s48_exception_unassigned_local 0 786 #define s48_exception_undefined_global 1 787 #define s48_exception_unbound_global 2 788 #define s48_exception_bad_procedure 3 789 #define s48_exception_wrong_number_of_arguments 4 790 #define s48_exception_wrong_type_argument 5 791 #define s48_exception_immutable_argument 6 792 #define s48_exception_arithmetic_overflow 7 793 #define s48_exception_index_out_of_range 8 794 #define s48_exception_heap_overflow 9 795 #define s48_exception_out_of_memory 10 796 #define s48_exception_cannot_open_channel 11 797 #define s48_exception_channel_os_index_already_in_use 12 798 #define s48_exception_closed_channel 13 799 #define s48_exception_buffer_fullempty 14 800 #define s48_exception_unimplemented_instruction 15 801 #define s48_exception_trap 16 802 #define s48_exception_proceeding_after_exception 17 803 #define s48_exception_bad_option 18 804 #define s48_exception_unbound_external_name 19 805 #define s48_exception_too_many_arguments_to_external_procedure 20 806 #define s48_exception_too_many_arguments_in_callback 21 807 #define s48_exception_callback_return_uncovered 22 808 #define s48_exception_extension_exception 23 809 #define s48_exception_extension_return_error 24 810 #define s48_exception_os_error 25 811 #define s48_exception_gc_protection_mismatch 26 812 #define s48_exception_no_current_proposal 27 813 #define s48_exception_native_code_not_supported 28 814 #define s48_exception_illegal_exception_return 29 815 #define s48_exception_external_error 30 816 #define s48_exception_external_assertion_violation 31 817 #define s48_exception_external_os_error 32 818 819 #define s48_channel_status_closed_2(c) s48_unsafe_enter_long_as_fixnum_2(c, 0) 820 #define s48_channel_status_input_2(c) s48_unsafe_enter_long_as_fixnum_2(c, 1) 821 #define s48_channel_status_output_2(c) s48_unsafe_enter_long_as_fixnum_2(c, 2) 822 #define s48_channel_status_special_input_2(c) s48_unsafe_enter_long_as_fixnum_2(c, 3) 823 #define s48_channel_status_special_output_2(c) s48_unsafe_enter_long_as_fixnum_2(c, 4) 824 825 #ifndef NO_OLD_FFI 826 827 #define S48_FIXNUM_TAG 0 828 #define S48_FIXNUM_P(x) (((long)(x) & 3L) == S48_FIXNUM_TAG) 829 #define S48_IMMEDIATE_TAG 1 830 #define S48_IMMEDIATE_P(x) (((long)(x) & 3L) == S48_IMMEDIATE_TAG) 831 #define S48_HEADER_TAG 2 832 #define S48_HEADER_P(x) (((long)(x) & 3L) == S48_HEADER_TAG) 833 #define S48_STOB_TAG 3 834 #define S48_STOB_P(x) (((long)(x) & 3L) == S48_STOB_TAG) 835 836 #define S48_UNSAFE_ENTER_FIXNUM(n) ((s48_value)((n) << 2)) 837 #define S48_UNSAFE_EXTRACT_FIXNUM(x) ((long)(x) >> 2) 838 839 #define S48_MISC_IMMEDIATE(n) (S48_IMMEDIATE_TAG | ((n) << 2)) 840 #define S48_FALSE (S48_MISC_IMMEDIATE(0)) 841 #define S48_TRUE (S48_MISC_IMMEDIATE(1)) 842 #define S48_CHAR (S48_MISC_IMMEDIATE(2)) 843 #define S48_UNSPECIFIC (S48_MISC_IMMEDIATE(3)) 844 #define S48_UNDEFINED (S48_MISC_IMMEDIATE(4)) 845 #define S48_EOF (S48_MISC_IMMEDIATE(5)) 846 #define S48_NULL (S48_MISC_IMMEDIATE(6)) 847 #define S48_UNRELEASED (S48_MISC_IMMEDIATE(7)) 848 849 #define S48_UNSAFE_ENTER_CHAR(c) (S48_CHAR | ((c) << 8)) 850 #define S48_UNSAFE_EXTRACT_CHAR(x) ((long)((x) >> 8)) 851 #define S48_CHAR_P(x) ((((long) (x)) & 0xff) == S48_CHAR) 852 853 #define ADDRESS_AFTER_HEADER_INTERNAL(x, type) ((type *)((x) - S48_STOB_TAG)) 854 #define STOB_REF_INTERNAL(x, i) ADDRESS_AFTER_HEADER_INTERNAL(x, s48_value)[i] 855 #define STOB_BYTE_REF_INTERNAL(x, i) (((char *) ADDRESS_AFTER_HEADER_INTERNAL(x, s48_value))[i]) 856 #define S48_ADDRESS_AFTER_HEADER(x, type) ADDRESS_AFTER_HEADER_INTERNAL(x, type) 857 #define S48_STOB_REF(x, i) STOB_REF_INTERNAL((x), i) 858 #define S48_STOB_BYTE_REF(x, i) STOB_BYTE_REF_INTERNAL((x), i) 859 #define S48_STOB_SET(x, i, v) do { s48_value __stob_set_x = (x); long __stob_set_i = (i); s48_value __stob_set_v = (v); if (S48_STOB_IMMUTABLEP(__stob_set_x)) s48_assertion_violation(NULL, "immutable stob", 1, __stob_set_x); else { S48_WRITE_BARRIER((__stob_set_x), (char *) (&S48_STOB_REF((__stob_set_x), (__stob_set_i))),(__stob_set_v)); *(&S48_STOB_REF((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } } while (0) 860 #define S48_STOB_BYTE_SET(x, i, v) do { s48_value __stob_set_x = (x); long __stob_set_i = (i); char __stob_set_v = (v); if (S48_STOB_IMMUTABLEP(__stob_set_x)) s48_assertion_violation(NULL, "immutable stob", 1, __stob_set_x); else *(&S48_STOB_BYTE_REF((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } while (0) 861 #define S48_STOB_HEADER(x) (S48_STOB_REF((x),-1)) 862 #define S48_STOB_TYPE(x) ((S48_STOB_HEADER(x)>>2)&31) 863 #define S48_STOB_ADDRESS(x) (&(S48_STOB_HEADER(x))) 864 #define S48_STOB_BYTE_LENGTH(x) ((unsigned long)S48_STOB_HEADER(x) >> 8) 865 #define S48_STOB_DESCRIPTOR_LENGTH(x) (S48_STOB_BYTE_LENGTH(x) >> S48_LOG_BYTES_PER_CELL) 866 #define S48_STOB_IMMUTABLEP(x) ((S48_STOB_HEADER(x)>>7) & 1) 867 #define S48_STOB_MAKE_IMMUTABLE(x) ((S48_STOB_HEADER(x)) |= (1<<7)) 868 869 #define S48_STOBTYPE_PAIR 0 870 #define S48_PAIR_P(x) (s48_stob_has_type(x, 0)) 871 #define S48_STOBTYPE_SYMBOL 1 872 #define S48_SYMBOL_P(x) (s48_stob_has_type(x, 1)) 873 #define S48_STOBTYPE_VECTOR 2 874 #define S48_VECTOR_P(x) (s48_stob_has_type(x, 2)) 875 #define S48_STOBTYPE_CLOSURE 3 876 #define S48_CLOSURE_P(x) (s48_stob_has_type(x, 3)) 877 #define S48_STOBTYPE_LOCATION 4 878 #define S48_LOCATION_P(x) (s48_stob_has_type(x, 4)) 879 #define S48_STOBTYPE_CELL 5 880 #define S48_CELL_P(x) (s48_stob_has_type(x, 5)) 881 #define S48_STOBTYPE_CHANNEL 6 882 #define S48_CHANNEL_P(x) (s48_stob_has_type(x, 6)) 883 #define S48_STOBTYPE_PORT 7 884 #define S48_PORT_P(x) (s48_stob_has_type(x, 7)) 885 #define S48_STOBTYPE_RATNUM 8 886 #define S48_RATNUM_P(x) (s48_stob_has_type(x, 8)) 887 #define S48_STOBTYPE_RECORD 9 888 #define S48_RECORD_P(x) (s48_stob_has_type(x, 9)) 889 #define S48_STOBTYPE_CONTINUATION 10 890 #define S48_CONTINUATION_P(x) (s48_stob_has_type(x, 10)) 891 #define S48_STOBTYPE_EXTENDED_NUMBER 11 892 #define S48_EXTENDED_NUMBER_P(x) (s48_stob_has_type(x, 11)) 893 #define S48_STOBTYPE_TEMPLATE 12 894 #define S48_TEMPLATE_P(x) (s48_stob_has_type(x, 12)) 895 #define S48_STOBTYPE_WEAK_POINTER 13 896 #define S48_WEAK_POINTER_P(x) (s48_stob_has_type(x, 13)) 897 #define S48_STOBTYPE_SHARED_BINDING 14 898 #define S48_SHARED_BINDING_P(x) (s48_stob_has_type(x, 14)) 899 #define S48_STOBTYPE_TRANSPORT_LINK_CELL 15 900 #define S48_TRANSPORT_LINK_CELL_P(x) (s48_stob_has_type(x, 15)) 901 #define S48_STOBTYPE_STRING 16 902 #define S48_STRING_P(x) (s48_stob_has_type(x, 16)) 903 #define S48_STOBTYPE_BYTE_VECTOR 17 904 #define S48_BYTE_VECTOR_P(x) (s48_stob_has_type(x, 17)) 905 #define S48_STOBTYPE_DOUBLE 18 906 #define S48_DOUBLE_P(x) (s48_stob_has_type(x, 18)) 907 #define S48_STOBTYPE_BIGNUM 19 908 #define S48_BIGNUM_P(x) (s48_stob_has_type(x, 19)) 909 910 #define S48_CAR_OFFSET 0 911 #define S48_CAR(x) (s48_stob_ref((x), S48_STOBTYPE_PAIR, 0)) 912 #define S48_UNSAFE_CAR(x) (S48_STOB_REF((x), 0)) 913 #define S48_SET_CAR(x, v) (s48_stob_set((x), S48_STOBTYPE_PAIR, 0, (v))) 914 #define S48_UNSAFE_SET_CAR(x, v) S48_STOB_SET((x), 0, (v)) 915 #define S48_CDR_OFFSET 1 916 #define S48_CDR(x) (s48_stob_ref((x), S48_STOBTYPE_PAIR, 1)) 917 #define S48_UNSAFE_CDR(x) (S48_STOB_REF((x), 1)) 918 #define S48_SET_CDR(x, v) (s48_stob_set((x), S48_STOBTYPE_PAIR, 1, (v))) 919 #define S48_UNSAFE_SET_CDR(x, v) S48_STOB_SET((x), 1, (v)) 920 #define S48_SYMBOL_TO_STRING_OFFSET 0 921 #define S48_SYMBOL_TO_STRING(x) (s48_stob_ref((x), S48_STOBTYPE_SYMBOL, 0)) 922 #define S48_UNSAFE_SYMBOL_TO_STRING(x) (S48_STOB_REF((x), 0)) 923 #define S48_LOCATION_ID_OFFSET 0 924 #define S48_LOCATION_ID(x) (s48_stob_ref((x), S48_STOBTYPE_LOCATION, 0)) 925 #define S48_UNSAFE_LOCATION_ID(x) (S48_STOB_REF((x), 0)) 926 #define S48_SET_LOCATION_ID(x, v) (s48_stob_set((x), S48_STOBTYPE_LOCATION, 0, (v))) 927 #define S48_UNSAFE_SET_LOCATION_ID(x, v) S48_STOB_SET((x), 0, (v)) 928 #define S48_CONTENTS_OFFSET 1 929 #define S48_CONTENTS(x) (s48_stob_ref((x), S48_STOBTYPE_LOCATION, 1)) 930 #define S48_UNSAFE_CONTENTS(x) (S48_STOB_REF((x), 1)) 931 #define S48_SET_CONTENTS(x, v) (s48_stob_set((x), S48_STOBTYPE_LOCATION, 1, (v))) 932 #define S48_UNSAFE_SET_CONTENTS(x, v) S48_STOB_SET((x), 1, (v)) 933 #define S48_CELL_REF_OFFSET 0 934 #define S48_CELL_REF(x) (s48_stob_ref((x), S48_STOBTYPE_CELL, 0)) 935 #define S48_UNSAFE_CELL_REF(x) (S48_STOB_REF((x), 0)) 936 #define S48_CELL_SET(x, v) (s48_stob_set((x), S48_STOBTYPE_CELL, 0, (v))) 937 #define S48_UNSAFE_CELL_SET(x, v) S48_STOB_SET((x), 0, (v)) 938 #define S48_CLOSURE_TEMPLATE_OFFSET 0 939 #define S48_CLOSURE_TEMPLATE(x) (s48_stob_ref((x), S48_STOBTYPE_CLOSURE, 0)) 940 #define S48_UNSAFE_CLOSURE_TEMPLATE(x) (S48_STOB_REF((x), 0)) 941 #define S48_SET_CLOSURE_TEMPLATE(x, v) (s48_stob_set((x), S48_STOBTYPE_CLOSURE, 0, (v))) 942 #define S48_UNSAFE_SET_CLOSURE_TEMPLATE(x, v) S48_STOB_SET((x), 0, (v)) 943 #define S48_CLOSURE_ENV_OFFSET 1 944 #define S48_CLOSURE_ENV(x) (s48_stob_ref((x), S48_STOBTYPE_CLOSURE, 1)) 945 #define S48_UNSAFE_CLOSURE_ENV(x) (S48_STOB_REF((x), 1)) 946 #define S48_SET_CLOSURE_ENV(x, v) (s48_stob_set((x), S48_STOBTYPE_CLOSURE, 1, (v))) 947 #define S48_UNSAFE_SET_CLOSURE_ENV(x, v) S48_STOB_SET((x), 1, (v)) 948 #define S48_WEAK_POINTER_REF_OFFSET 0 949 #define S48_WEAK_POINTER_REF(x) (s48_stob_ref((x), S48_STOBTYPE_WEAK_POINTER, 0)) 950 #define S48_UNSAFE_WEAK_POINTER_REF(x) (S48_STOB_REF((x), 0)) 951 #define S48_SHARED_BINDING_NAME_OFFSET 0 952 #define S48_SHARED_BINDING_NAME(x) (s48_stob_ref((x), S48_STOBTYPE_SHARED_BINDING, 0)) 953 #define S48_UNSAFE_SHARED_BINDING_NAME(x) (S48_STOB_REF((x), 0)) 954 #define S48_SHARED_BINDING_IS_IMPORTP_OFFSET 1 955 #define S48_SHARED_BINDING_IS_IMPORTP(x) (s48_stob_ref((x), S48_STOBTYPE_SHARED_BINDING, 1)) 956 #define S48_UNSAFE_SHARED_BINDING_IS_IMPORTP(x) (S48_STOB_REF((x), 1)) 957 #define S48_SHARED_BINDING_REF_OFFSET 2 958 #define S48_SHARED_BINDING_REF(x) (s48_stob_ref((x), S48_STOBTYPE_SHARED_BINDING, 2)) 959 #define S48_UNSAFE_SHARED_BINDING_REF(x) (S48_STOB_REF((x), 2)) 960 #define S48_SHARED_BINDING_SET(x, v) (s48_stob_set((x), S48_STOBTYPE_SHARED_BINDING, 2, (v))) 961 #define S48_UNSAFE_SHARED_BINDING_SET(x, v) S48_STOB_SET((x), 2, (v)) 962 #define S48_PORT_HANDLER_OFFSET 0 963 #define S48_PORT_HANDLER(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 0)) 964 #define S48_UNSAFE_PORT_HANDLER(x) (S48_STOB_REF((x), 0)) 965 #define S48_PORT_TEXT_CODEC_SPEC_OFFSET 1 966 #define S48_PORT_TEXT_CODEC_SPEC(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 1)) 967 #define S48_UNSAFE_PORT_TEXT_CODEC_SPEC(x) (S48_STOB_REF((x), 1)) 968 #define S48_SET_PORT_TEXT_CODEC_SPEC(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 1, (v))) 969 #define S48_UNSAFE_SET_PORT_TEXT_CODEC_SPEC(x, v) S48_STOB_SET((x), 1, (v)) 970 #define S48_PORT_CRLFP_OFFSET 2 971 #define S48_PORT_CRLFP(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 2)) 972 #define S48_UNSAFE_PORT_CRLFP(x) (S48_STOB_REF((x), 2)) 973 #define S48_SET_PORT_CRLFP(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 2, (v))) 974 #define S48_UNSAFE_SET_PORT_CRLFP(x, v) S48_STOB_SET((x), 2, (v)) 975 #define S48_PORT_STATUS_OFFSET 3 976 #define S48_PORT_STATUS(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 3)) 977 #define S48_UNSAFE_PORT_STATUS(x) (S48_STOB_REF((x), 3)) 978 #define S48_SET_PORT_STATUS(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 3, (v))) 979 #define S48_UNSAFE_SET_PORT_STATUS(x, v) S48_STOB_SET((x), 3, (v)) 980 #define S48_PORT_LOCK_OFFSET 4 981 #define S48_PORT_LOCK(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 4)) 982 #define S48_UNSAFE_PORT_LOCK(x) (S48_STOB_REF((x), 4)) 983 #define S48_SET_PORT_LOCK(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 4, (v))) 984 #define S48_UNSAFE_SET_PORT_LOCK(x, v) S48_STOB_SET((x), 4, (v)) 985 #define S48_PORT_DATA_OFFSET 5 986 #define S48_PORT_DATA(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 5)) 987 #define S48_UNSAFE_PORT_DATA(x) (S48_STOB_REF((x), 5)) 988 #define S48_SET_PORT_DATA(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 5, (v))) 989 #define S48_UNSAFE_SET_PORT_DATA(x, v) S48_STOB_SET((x), 5, (v)) 990 #define S48_PORT_BUFFER_OFFSET 6 991 #define S48_PORT_BUFFER(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 6)) 992 #define S48_UNSAFE_PORT_BUFFER(x) (S48_STOB_REF((x), 6)) 993 #define S48_SET_PORT_BUFFER(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 6, (v))) 994 #define S48_UNSAFE_SET_PORT_BUFFER(x, v) S48_STOB_SET((x), 6, (v)) 995 #define S48_PORT_INDEX_OFFSET 7 996 #define S48_PORT_INDEX(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 7)) 997 #define S48_UNSAFE_PORT_INDEX(x) (S48_STOB_REF((x), 7)) 998 #define S48_SET_PORT_INDEX(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 7, (v))) 999 #define S48_UNSAFE_SET_PORT_INDEX(x, v) S48_STOB_SET((x), 7, (v)) 1000 #define S48_PORT_LIMIT_OFFSET 8 1001 #define S48_PORT_LIMIT(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 8)) 1002 #define S48_UNSAFE_PORT_LIMIT(x) (S48_STOB_REF((x), 8)) 1003 #define S48_SET_PORT_LIMIT(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 8, (v))) 1004 #define S48_UNSAFE_SET_PORT_LIMIT(x, v) S48_STOB_SET((x), 8, (v)) 1005 #define S48_PORT_PENDING_CRP_OFFSET 9 1006 #define S48_PORT_PENDING_CRP(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 9)) 1007 #define S48_UNSAFE_PORT_PENDING_CRP(x) (S48_STOB_REF((x), 9)) 1008 #define S48_SET_PORT_PENDING_CRP(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 9, (v))) 1009 #define S48_UNSAFE_SET_PORT_PENDING_CRP(x, v) S48_STOB_SET((x), 9, (v)) 1010 #define S48_PORT_PENDING_EOFP_OFFSET 10 1011 #define S48_PORT_PENDING_EOFP(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 10)) 1012 #define S48_UNSAFE_PORT_PENDING_EOFP(x) (S48_STOB_REF((x), 10)) 1013 #define S48_SET_PORT_PENDING_EOFP(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 10, (v))) 1014 #define S48_UNSAFE_SET_PORT_PENDING_EOFP(x, v) S48_STOB_SET((x), 10, (v)) 1015 #define S48_CHANNEL_STATUS_OFFSET 0 1016 #define S48_CHANNEL_STATUS(x) (s48_stob_ref((x), S48_STOBTYPE_CHANNEL, 0)) 1017 #define S48_UNSAFE_CHANNEL_STATUS(x) (S48_STOB_REF((x), 0)) 1018 #define S48_CHANNEL_ID_OFFSET 1 1019 #define S48_CHANNEL_ID(x) (s48_stob_ref((x), S48_STOBTYPE_CHANNEL, 1)) 1020 #define S48_UNSAFE_CHANNEL_ID(x) (S48_STOB_REF((x), 1)) 1021 #define S48_CHANNEL_OS_INDEX_OFFSET 2 1022 #define S48_CHANNEL_OS_INDEX(x) (s48_stob_ref((x), S48_STOBTYPE_CHANNEL, 2)) 1023 #define S48_UNSAFE_CHANNEL_OS_INDEX(x) (S48_STOB_REF((x), 2)) 1024 #define S48_CHANNEL_CLOSE_SILENTLYP_OFFSET 3 1025 #define S48_CHANNEL_CLOSE_SILENTLYP(x) (s48_stob_ref((x), S48_STOBTYPE_CHANNEL, 3)) 1026 #define S48_UNSAFE_CHANNEL_CLOSE_SILENTLYP(x) (S48_STOB_REF((x), 3)) 1027 #define S48_TRANSPORT_LINK_CELL_KEY_OFFSET 0 1028 #define S48_TRANSPORT_LINK_CELL_KEY(x) (s48_stob_ref((x), S48_STOBTYPE_TRANSPORT_LINK_CELL, 0)) 1029 #define S48_UNSAFE_TRANSPORT_LINK_CELL_KEY(x) (S48_STOB_REF((x), 0)) 1030 #define S48_TRANSPORT_LINK_CELL_VALUE_OFFSET 1 1031 #define S48_TRANSPORT_LINK_CELL_VALUE(x) (s48_stob_ref((x), S48_STOBTYPE_TRANSPORT_LINK_CELL, 1)) 1032 #define S48_UNSAFE_TRANSPORT_LINK_CELL_VALUE(x) (S48_STOB_REF((x), 1)) 1033 #define S48_SET_TRANSPORT_LINK_CELL_VALUE(x, v) (s48_stob_set((x), S48_STOBTYPE_TRANSPORT_LINK_CELL, 1, (v))) 1034 #define S48_UNSAFE_SET_TRANSPORT_LINK_CELL_VALUE(x, v) S48_STOB_SET((x), 1, (v)) 1035 #define S48_TRANSPORT_LINK_CELL_TCONC_OFFSET 2 1036 #define S48_TRANSPORT_LINK_CELL_TCONC(x) (s48_stob_ref((x), S48_STOBTYPE_TRANSPORT_LINK_CELL, 2)) 1037 #define S48_UNSAFE_TRANSPORT_LINK_CELL_TCONC(x) (S48_STOB_REF((x), 2)) 1038 #define S48_SET_TRANSPORT_LINK_CELL_TCONC(x, v) (s48_stob_set((x), S48_STOBTYPE_TRANSPORT_LINK_CELL, 2, (v))) 1039 #define S48_UNSAFE_SET_TRANSPORT_LINK_CELL_TCONC(x, v) S48_STOB_SET((x), 2, (v)) 1040 #define S48_TRANSPORT_LINK_CELL_NEXT_OFFSET 3 1041 #define S48_TRANSPORT_LINK_CELL_NEXT(x) (s48_stob_ref((x), S48_STOBTYPE_TRANSPORT_LINK_CELL, 3)) 1042 #define S48_UNSAFE_TRANSPORT_LINK_CELL_NEXT(x) (S48_STOB_REF((x), 3)) 1043 #define S48_SET_TRANSPORT_LINK_CELL_NEXT(x, v) (s48_stob_set((x), S48_STOBTYPE_TRANSPORT_LINK_CELL, 3, (v))) 1044 #define S48_UNSAFE_SET_TRANSPORT_LINK_CELL_NEXT(x, v) S48_STOB_SET((x), 3, (v)) 1045 1046 #define S48_VECTOR_LENGTH(x) (s48_stob_length((x), S48_STOBTYPE_VECTOR)) 1047 #define S48_UNSAFE_VECTOR_LENGTH(x) (S48_STOB_DESCRIPTOR_LENGTH(x)) 1048 #define S48_VECTOR_REF(x, i) (s48_stob_ref((x), S48_STOBTYPE_VECTOR, (i))) 1049 #define S48_VECTOR_SET(x, i, v) (s48_stob_set((x), S48_STOBTYPE_VECTOR, (i), (v))) 1050 #define S48_UNSAFE_VECTOR_REF(x, i) (S48_STOB_REF((x), (i))) 1051 #define S48_UNSAFE_VECTOR_SET(x, i, v) S48_STOB_SET((x), (i), (v)) 1052 #define S48_RECORD_LENGTH(x) (s48_stob_length((x), S48_STOBTYPE_RECORD)) 1053 #define S48_UNSAFE_RECORD_LENGTH(x) (S48_STOB_DESCRIPTOR_LENGTH(x)) 1054 #define S48_RECORD_REF(x, i) (s48_stob_ref((x), S48_STOBTYPE_RECORD, (i) + 1)) 1055 #define S48_RECORD_SET(x, i, v) (s48_stob_set((x), S48_STOBTYPE_RECORD, (i) + 1, (v))) 1056 #define S48_UNSAFE_RECORD_REF(x, i) (S48_STOB_REF((x), (i) + 1)) 1057 #define S48_UNSAFE_RECORD_SET(x, i, v) S48_STOB_SET((x), (i) + 1, (v)) 1058 #define S48_RECORD_TYPE(x) (s48_stob_ref((x), S48_STOBTYPE_RECORD, 0)) 1059 #define S48_UNSAFE_RECORD_TYPE(x) (S48_STOB_REF((x), 0)) 1060 #define S48_BYTE_VECTOR_LENGTH(x) (s48_stob_byte_length((x), S48_STOBTYPE_BYTE_VECTOR)) 1061 #define S48_BYTE_VECTOR_REF(x, i) (s48_stob_byte_ref((x), S48_STOBTYPE_BYTE_VECTOR, (i))) 1062 #define S48_BYTE_VECTOR_SET(x, i, v) (s48_stob_byte_set((x), S48_STOBTYPE_BYTE_VECTOR, (i), (v))) 1063 #define S48_UNSAFE_BYTE_VECTOR_REF(x, i) (S48_STOB_BYTE_REF((x), (i))) 1064 #define S48_UNSAFE_BYTE_VECTOR_SET(x, i, v) S48_BYTE_STOB_SET((x), (i), (v)) 1065 #define S48_UNSAFE_BYTE_VECTOR_LENGTH(x) (S48_STOB_BYTE_LENGTH(x)) 1066 #define S48_UNSAFE_EXTRACT_BYTE_VECTOR(x) (S48_ADDRESS_AFTER_HEADER((x), char)) 1067 #define S48_STRING_LENGTH(s) (s48_string_length(s)) 1068 #define S48_STRING_REF(s, i) (s48_string_ref((s), (i))) 1069 #define S48_STRING_SET(s, i, v) (s48_string_set((s), (i), (v))) 1070 #define S48_EXTRACT_EXTERNAL_OBJECT(x, type) ((type *)(S48_ADDRESS_AFTER_HEADER(x, long)+1)) 1071 1072 #define S48_RECORD_TYPE_RESUMER(x) S48_RECORD_REF((x), 0) 1073 #define S48_RECORD_TYPE_UID(x) S48_RECORD_REF((x), 1) 1074 #define S48_RECORD_TYPE_NAME(x) S48_RECORD_REF((x), 2) 1075 #define S48_RECORD_TYPE_FIELD_NAMES(x) S48_RECORD_REF((x), 3) 1076 #define S48_RECORD_TYPE_NUMBER_OF_FIELDS(x) S48_RECORD_REF((x), 4) 1077 #define S48_RECORD_TYPE_DISCLOSER(x) S48_RECORD_REF((x), 5) 1078 #define S48_RECORD_TYPE_PARENT(x) S48_RECORD_REF((x), 6) 1079 #define S48_RECORD_TYPE_EXTENSION_COUNT(x) S48_RECORD_REF((x), 7) 1080 #define S48_RECORD_TYPE_SIZE(x) S48_RECORD_REF((x), 8) 1081 #define S48_RECORD_TYPE_DATA(x) S48_RECORD_REF((x), 9) 1082 #define S48_RECORD_TYPE_BASE(x) S48_RECORD_REF((x), 10) 1083 1084 #define S48_CHANNEL_STATUS_CLOSED S48_UNSAFE_ENTER_FIXNUM(0) 1085 #define S48_CHANNEL_STATUS_INPUT S48_UNSAFE_ENTER_FIXNUM(1) 1086 #define S48_CHANNEL_STATUS_OUTPUT S48_UNSAFE_ENTER_FIXNUM(2) 1087 #define S48_CHANNEL_STATUS_SPECIAL_INPUT S48_UNSAFE_ENTER_FIXNUM(3) 1088 #define S48_CHANNEL_STATUS_SPECIAL_OUTPUT S48_UNSAFE_ENTER_FIXNUM(4) 1089 1090 #endif /* !NO_OLD_FFI */ 1091 1092 #define S48_EXCEPTION_UNASSIGNED_LOCAL 0 1093 #define S48_EXCEPTION_UNDEFINED_GLOBAL 1 1094 #define S48_EXCEPTION_UNBOUND_GLOBAL 2 1095 #define S48_EXCEPTION_BAD_PROCEDURE 3 1096 #define S48_EXCEPTION_WRONG_NUMBER_OF_ARGUMENTS 4 1097 #define S48_EXCEPTION_WRONG_TYPE_ARGUMENT 5 1098 #define S48_EXCEPTION_IMMUTABLE_ARGUMENT 6 1099 #define S48_EXCEPTION_ARITHMETIC_OVERFLOW 7 1100 #define S48_EXCEPTION_INDEX_OUT_OF_RANGE 8 1101 #define S48_EXCEPTION_HEAP_OVERFLOW 9 1102 #define S48_EXCEPTION_OUT_OF_MEMORY 10 1103 #define S48_EXCEPTION_CANNOT_OPEN_CHANNEL 11 1104 #define S48_EXCEPTION_CHANNEL_OS_INDEX_ALREADY_IN_USE 12 1105 #define S48_EXCEPTION_CLOSED_CHANNEL 13 1106 #define S48_EXCEPTION_BUFFER_FULLEMPTY 14 1107 #define S48_EXCEPTION_UNIMPLEMENTED_INSTRUCTION 15 1108 #define S48_EXCEPTION_TRAP 16 1109 #define S48_EXCEPTION_PROCEEDING_AFTER_EXCEPTION 17 1110 #define S48_EXCEPTION_BAD_OPTION 18 1111 #define S48_EXCEPTION_UNBOUND_EXTERNAL_NAME 19 1112 #define S48_EXCEPTION_TOO_MANY_ARGUMENTS_TO_EXTERNAL_PROCEDURE 20 1113 #define S48_EXCEPTION_TOO_MANY_ARGUMENTS_IN_CALLBACK 21 1114 #define S48_EXCEPTION_CALLBACK_RETURN_UNCOVERED 22 1115 #define S48_EXCEPTION_EXTENSION_EXCEPTION 23 1116 #define S48_EXCEPTION_EXTENSION_RETURN_ERROR 24 1117 #define S48_EXCEPTION_OS_ERROR 25 1118 #define S48_EXCEPTION_GC_PROTECTION_MISMATCH 26 1119 #define S48_EXCEPTION_NO_CURRENT_PROPOSAL 27 1120 #define S48_EXCEPTION_NATIVE_CODE_NOT_SUPPORTED 28 1121 #define S48_EXCEPTION_ILLEGAL_EXCEPTION_RETURN 29 1122 #define S48_EXCEPTION_EXTERNAL_ERROR 30 1123 #define S48_EXCEPTION_EXTERNAL_ASSERTION_VIOLATION 31 1124 #define S48_EXCEPTION_EXTERNAL_OS_ERROR 32 1125 1126 #include <scheme48write-barrier.h> 1127 1128 #ifdef __cplusplus 1129 /* closing brace for extern "C" */ 1130 } 1131 #endif 1132 1133 #endif /* _H_SCHEME48 */ 1134