diff options
author | Andy Wingo <wingo@pobox.com> | 2011-10-24 17:58:22 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-10-24 18:54:04 +0200 |
commit | 21041372ed4a3c837f6d16149648508d49b4b2e2 (patch) | |
tree | 77121f605195cc7effb3874c6df583bf9df5dc55 | |
parent | dc7da0be90d6033d512f9772894179970af678e7 (diff) | |
download | guile-21041372ed4a3c837f6d16149648508d49b4b2e2.tar.gz |
add SCM_{PACK,UNPACK}_POINTER
* libguile/tags.h (SCM_UNPACK_POINTER, SCM_PACK_POINTER): New macros.
The old SCM2PTR and PTR2SCM were defined in such a way that
round-tripping through a pointer could lose precision, even in the
case in which you weren't interested in actually dereferencing the
pointer, it was simply that you needed to plumb a SCM through APIs
that take pointers. These new macros are more like SCM_PACK and
SCM_UNPACK, but for pointer types. The bit representation of the
pointer should be the same as the scm_t_bits representation.
* libguile/gc.h (PTR2SCM, SCM2PTR): Remove support for (old) UNICOS
pointers. We are going to try tagging the SCM object itself in the
future, and I don't think that keeping this support is worth its
cost. It probably doesn't work anyway.
* libguile/backtrace.c:
* libguile/bytevectors.c:
* libguile/continuations.c:
* libguile/fluids.c:
* libguile/foreign.c:
* libguile/gc.h:
* libguile/guardians.c:
* libguile/hashtab.c:
* libguile/load.c:
* libguile/numbers.c:
* libguile/ports.c:
* libguile/smob.c:
* libguile/strings.c:
* libguile/symbols.c:
* libguile/vm.c:
* libguile/weak-set.c:
* libguile/weak-table.c:
* libguile/weak-vector.c: Update many sites to use the new macros.
-rw-r--r-- | libguile/backtrace.c | 4 | ||||
-rw-r--r-- | libguile/bytevectors.c | 4 | ||||
-rw-r--r-- | libguile/continuations.c | 6 | ||||
-rw-r--r-- | libguile/fluids.c | 4 | ||||
-rw-r--r-- | libguile/foreign.c | 6 | ||||
-rw-r--r-- | libguile/gc.h | 25 | ||||
-rw-r--r-- | libguile/guardians.c | 20 | ||||
-rw-r--r-- | libguile/hashtab.c | 4 | ||||
-rw-r--r-- | libguile/load.c | 8 | ||||
-rw-r--r-- | libguile/numbers.c | 6 | ||||
-rw-r--r-- | libguile/ports.c | 6 | ||||
-rw-r--r-- | libguile/smob.c | 12 | ||||
-rw-r--r-- | libguile/strings.c | 4 | ||||
-rw-r--r-- | libguile/symbols.c | 4 | ||||
-rw-r--r-- | libguile/tags.h | 5 | ||||
-rw-r--r-- | libguile/vm.c | 6 | ||||
-rw-r--r-- | libguile/weak-set.c | 22 | ||||
-rw-r--r-- | libguile/weak-table.c | 24 | ||||
-rw-r--r-- | libguile/weak-vector.c | 4 |
19 files changed, 83 insertions, 91 deletions
diff --git a/libguile/backtrace.c b/libguile/backtrace.c index db22c17e9..a9b37fd7c 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -511,7 +511,7 @@ display_backtrace_body (struct display_backtrace_args *a) static SCM error_during_backtrace (void *data, SCM tag, SCM throw_args) { - SCM port = PTR2SCM (data); + SCM port = SCM_PACK_POINTER (data); scm_puts ("Exception thrown while printing backtrace:\n", port); scm_print_exception (port, SCM_BOOL_F, tag, throw_args); @@ -544,7 +544,7 @@ SCM_DEFINE (scm_display_backtrace_with_highlights, "display-backtrace", 2, 3, 0, scm_internal_catch (SCM_BOOL_T, (scm_t_catch_body) display_backtrace_body, &a, - (scm_t_catch_handler) error_during_backtrace, SCM2PTR (port)); + (scm_t_catch_handler) error_during_backtrace, SCM_UNPACK_POINTER (port)); return SCM_UNSPECIFIED; } diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 8fc025285..96b9ab66f 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -229,7 +229,7 @@ make_bytevector (size_t len, scm_t_array_element_type element_type) contents = scm_gc_malloc_pointerless (SCM_BYTEVECTOR_HEADER_BYTES + c_len, SCM_GC_BYTEVECTOR); - ret = PTR2SCM (contents); + ret = SCM_PACK_POINTER (contents); contents += SCM_BYTEVECTOR_HEADER_BYTES; SCM_BYTEVECTOR_SET_LENGTH (ret, c_len); @@ -257,7 +257,7 @@ make_bytevector_from_buffer (size_t len, void *contents, { size_t c_len; - ret = PTR2SCM (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES, + ret = SCM_PACK_POINTER (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES, SCM_GC_BYTEVECTOR)); c_len = len * (scm_i_array_element_type_sizes[element_type] / 8); diff --git a/libguile/continuations.c b/libguile/continuations.c index 7e2096698..7a842de5c 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -543,7 +543,7 @@ pre_unwind_handler (void *error_port, SCM tag, SCM args) { /* Print the exception unless TAG is `quit'. */ if (!scm_is_eq (tag, scm_from_latin1_symbol ("quit"))) - print_exception_and_backtrace (PTR2SCM (error_port), tag, args); + print_exception_and_backtrace (SCM_PACK_POINTER (error_port), tag, args); return SCM_UNSPECIFIED; } @@ -557,7 +557,7 @@ scm_c_with_continuation_barrier (void *(*func) (void *), void *data) scm_i_with_continuation_barrier (c_body, &c_data, c_handler, &c_data, pre_unwind_handler, - SCM2PTR (scm_current_error_port ())); + SCM_UNPACK_POINTER (scm_current_error_port ())); return c_data.result; } @@ -601,7 +601,7 @@ SCM_DEFINE (scm_with_continuation_barrier, "with-continuation-barrier", 1,0,0, return scm_i_with_continuation_barrier (scm_body, &scm_data, scm_handler, &scm_data, pre_unwind_handler, - SCM2PTR (scm_current_error_port ())); + SCM_UNPACK_POINTER (scm_current_error_port ())); } #undef FUNC_NAME diff --git a/libguile/fluids.c b/libguile/fluids.c index 67efd9f6a..7f0e70424 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -110,7 +110,7 @@ new_fluid () /* Fluids are pointerless cells: the first word is the type tag; the second word is the fluid number. */ - fluid = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_cell), "fluid")); + fluid = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_cell), "fluid")); SCM_SET_CELL_TYPE (fluid, scm_tc7_fluid); scm_dynwind_begin (0); @@ -156,7 +156,7 @@ new_fluid () allocated_fluids_len += FLUID_GROW; } - allocated_fluids[n] = SCM2PTR (fluid); + allocated_fluids[n] = SCM_UNPACK_POINTER (fluid); SCM_SET_CELL_WORD_1 (fluid, (scm_t_bits) n); GC_GENERAL_REGISTER_DISAPPEARING_LINK (&allocated_fluids[n], diff --git a/libguile/foreign.c b/libguile/foreign.c index 2a11fb087..62ebb03ac 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -99,7 +99,7 @@ static void pointer_finalizer_trampoline (GC_PTR ptr, GC_PTR data) { scm_t_pointer_finalizer finalizer = data; - finalizer (SCM_POINTER_VALUE (PTR2SCM (ptr))); + finalizer (SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr))); } SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0, @@ -1102,7 +1102,7 @@ invoke_closure (ffi_cif *cif, void *ret, void **args, void *data) size_t i; SCM proc, *argv, result; - proc = PTR2SCM (data); + proc = SCM_PACK_POINTER (data); argv = alloca (cif->nargs * sizeof (*argv)); @@ -1133,7 +1133,7 @@ SCM_DEFINE (scm_procedure_to_pointer, "procedure->pointer", 3, 0, 0, closure = ffi_closure_alloc (sizeof (ffi_closure), &executable); err = ffi_prep_closure_loc ((ffi_closure *) closure, cif, - invoke_closure, SCM2PTR (proc), + invoke_closure, SCM_UNPACK_POINTER (proc), executable); if (err != FFI_OK) { diff --git a/libguile/gc.h b/libguile/gc.h index f062942ec..b4b725c23 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -35,22 +35,9 @@ typedef struct scm_t_cell SCM word_1; } scm_t_cell; -/* Cray machines have pointers that are incremented once for each - * word, rather than each byte, the 3 most significant bits encode the - * byte within the word. The following macros deal with this by - * storing the native Cray pointers like the ones that looks like scm - * expects. This is done for any pointers that point to a cell, - * pointers to scm_vector elts, functions, &c are not munged. - */ -#ifdef _UNICOS -# define SCM2PTR(x) ((scm_t_cell *) (SCM_UNPACK (x) >> 3)) -# define PTR2SCM(x) (SCM_PACK (((scm_t_bits) (x)) << 3)) -#else -# define SCM2PTR(x) ((scm_t_cell *) (SCM_UNPACK (x))) -# define PTR2SCM(x) (SCM_PACK ((scm_t_bits) (x))) -#endif /* def _UNICOS */ - - +/* FIXME: deprecate. */ +#define PTR2SCM(x) (SCM_PACK_POINTER (x)) +#define SCM2PTR(x) ((scm_t_cell *) (SCM_UNPACK_POINTER (x))) /* Low level cell data accessing macros. These macros should only be used * from within code related to garbage collection issues, since they will @@ -212,7 +199,7 @@ SCM_INLINE SCM scm_words (scm_t_bits car, scm_t_uint16 n_words); SCM_INLINE_IMPLEMENTATION SCM scm_cell (scm_t_bits car, scm_t_bits cdr) { - SCM cell = PTR2SCM (SCM_GC_MALLOC (sizeof (scm_t_cell))); + SCM cell = SCM_PACK_POINTER (SCM_GC_MALLOC (sizeof (scm_t_cell))); /* Initialize the type slot last so that the cell is ignored by the GC until it is completely initialized. This is only relevant when the GC @@ -230,7 +217,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, { SCM z; - z = PTR2SCM (SCM_GC_MALLOC (2 * sizeof (scm_t_cell))); + z = SCM_PACK_POINTER (SCM_GC_MALLOC (2 * sizeof (scm_t_cell))); /* Initialize the type slot last so that the cell is ignored by the GC until it is completely initialized. This is only relevant when the GC can actually run during this code, which it can't @@ -269,7 +256,7 @@ scm_words (scm_t_bits car, scm_t_uint16 n_words) { SCM z; - z = PTR2SCM (SCM_GC_MALLOC (sizeof (scm_t_bits) * n_words)); + z = SCM_PACK_POINTER (SCM_GC_MALLOC (sizeof (scm_t_bits) * n_words)); SCM_GC_SET_CELL_WORD (z, 0, car); /* FIXME: is the following concern even relevant with BDW-GC? */ diff --git a/libguile/guardians.c b/libguile/guardians.c index 076df00df..6aa7a1475 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -108,9 +108,9 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data) SCM cell_pool; SCM obj, guardian_list, proxied_finalizer; - obj = PTR2SCM (ptr); - guardian_list = SCM_CDR (PTR2SCM (finalizer_data)); - proxied_finalizer = SCM_CAR (PTR2SCM (finalizer_data)); + obj = SCM_PACK_POINTER (ptr); + guardian_list = SCM_CDR (SCM_PACK_POINTER (finalizer_data)); + proxied_finalizer = SCM_CAR (SCM_PACK_POINTER (finalizer_data)); #ifdef DEBUG_GUARDIANS printf ("finalizing guarded %p (%u guardians)\n", @@ -168,8 +168,8 @@ finalize_guarded (GC_PTR ptr, GC_PTR finalizer_data) GC_finalization_proc finalizer, prev_finalizer; GC_PTR finalizer_data, prev_finalizer_data; - finalizer = (GC_finalization_proc) SCM2PTR (SCM_CAR (proxied_finalizer)); - finalizer_data = SCM2PTR (SCM_CDR (proxied_finalizer)); + finalizer = (GC_finalization_proc) SCM_UNPACK_POINTER (SCM_CAR (proxied_finalizer)); + finalizer_data = SCM_UNPACK_POINTER (SCM_CDR (proxied_finalizer)); if (finalizer == NULL) abort (); @@ -218,8 +218,8 @@ scm_i_guard (SCM guardian, SCM obj) SCM_EOL); finalizer_data = scm_cons (SCM_BOOL_F, guardians_for_obj); - GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (obj), finalize_guarded, - SCM2PTR (finalizer_data), + GC_REGISTER_FINALIZER_NO_ORDER (SCM_UNPACK_POINTER (obj), finalize_guarded, + SCM_UNPACK_POINTER (finalizer_data), &prev_finalizer, &prev_data); if (prev_finalizer == finalize_guarded) @@ -231,7 +231,7 @@ scm_i_guard (SCM guardian, SCM obj) if (prev_data == NULL) abort (); - prev_finalizer_data = PTR2SCM (prev_data); + prev_finalizer_data = SCM_PACK_POINTER (prev_data); if (!scm_is_pair (prev_finalizer_data)) abort (); @@ -248,8 +248,8 @@ scm_i_guard (SCM guardian, SCM obj) `finalize_guarded ()' has finished. */ SCM proxied_finalizer; - proxied_finalizer = scm_cons (PTR2SCM (prev_finalizer), - PTR2SCM (prev_data)); + proxied_finalizer = scm_cons (SCM_PACK_POINTER (prev_finalizer), + SCM_PACK_POINTER (prev_data)); SCM_SETCAR (finalizer_data, proxied_finalizer); } } diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 1f1f69ca5..55f088149 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -491,7 +491,7 @@ SCM_DEFINE (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0, static int assv_predicate (SCM k, SCM v, void *closure) { - return scm_is_true (scm_eqv_p (k, PTR2SCM (closure))); + return scm_is_true (scm_eqv_p (k, SCM_PACK_POINTER (closure))); } SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0, @@ -596,7 +596,7 @@ SCM_DEFINE (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0, static int assoc_predicate (SCM k, SCM v, void *closure) { - return scm_is_true (scm_equal_p (k, PTR2SCM (closure))); + return scm_is_true (scm_equal_p (k, SCM_PACK_POINTER (closure))); } SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0, diff --git a/libguile/load.c b/libguile/load.c index 21008cbef..c6e688789 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -682,7 +682,7 @@ SCM_SYMBOL (sym_auto_compilation_options, "%auto-compilation-options"); static SCM do_try_auto_compile (void *data) { - SCM source = PTR2SCM (data); + SCM source = SCM_PACK_POINTER (data); SCM comp_mod, compile_file; scm_puts (";;; compiling ", scm_current_error_port ()); @@ -732,7 +732,7 @@ do_try_auto_compile (void *data) static SCM auto_compile_catch_handler (void *data, SCM tag, SCM throw_args) { - SCM source = PTR2SCM (data); + SCM source = SCM_PACK_POINTER (data); SCM oport, lines; oport = scm_open_output_string (); @@ -784,9 +784,9 @@ scm_try_auto_compile (SCM source) scm_sys_warn_auto_compilation_enabled (); return scm_c_catch (SCM_BOOL_T, do_try_auto_compile, - SCM2PTR (source), + SCM_UNPACK_POINTER (source), auto_compile_catch_handler, - SCM2PTR (source), + SCM_UNPACK_POINTER (source), NULL, NULL); } diff --git a/libguile/numbers.c b/libguile/numbers.c index 19673b84a..96e176590 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -178,7 +178,7 @@ finalize_bignum (GC_PTR ptr, GC_PTR data) { SCM bignum; - bignum = PTR2SCM (ptr); + bignum = SCM_PACK_POINTER (ptr); mpz_clear (SCM_I_BIG_MPZ (bignum)); } @@ -8655,7 +8655,7 @@ scm_c_make_rectangular (double re, double im) { SCM z; - z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_complex), + z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_complex), "complex")); SCM_SET_CELL_TYPE (z, scm_tc16_complex); SCM_COMPLEX_REAL (z) = re; @@ -9307,7 +9307,7 @@ scm_from_double (double val) { SCM z; - z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real")); + z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real")); SCM_SET_CELL_TYPE (z, scm_tc16_real); SCM_REAL_VALUE (z) = val; diff --git a/libguile/ports.c b/libguile/ports.c index 6c4561eac..3a942f7b8 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -535,7 +535,7 @@ static void finalize_port (GC_PTR ptr, GC_PTR data) { long port_type; - SCM port = PTR2SCM (ptr); + SCM port = SCM_PACK_POINTER (ptr); if (!SCM_PORTP (port)) abort (); @@ -877,7 +877,7 @@ scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data) static void scm_for_each_trampoline (void *data, SCM port) { - scm_call_1 (PTR2SCM (data), port); + scm_call_1 (SCM_PACK_POINTER (data), port); } SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0, @@ -892,7 +892,7 @@ SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0, { SCM_VALIDATE_PROC (1, proc); - scm_c_port_for_each (scm_for_each_trampoline, SCM2PTR (proc)); + scm_c_port_for_each (scm_for_each_trampoline, SCM_UNPACK_POINTER (proc)); return SCM_UNSPECIFIED; } diff --git a/libguile/smob.c b/libguile/smob.c index ab8208ccc..9098dbc3e 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -479,7 +479,7 @@ smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr, register SCM cell; register scm_t_bits tc, smobnum; - cell = PTR2SCM (addr); + cell = SCM_PACK_POINTER (addr); if (SCM_TYP7 (cell) != scm_tc7_smob) /* It is likely that the GC passed us a pointer to a free-list element @@ -568,7 +568,7 @@ finalize_smob (GC_PTR ptr, GC_PTR data) SCM smob; size_t (* free_smob) (SCM); - smob = PTR2SCM (ptr); + smob = SCM_PACK_POINTER (ptr); #if 0 printf ("finalizing SMOB %p (smobnum: %u)\n", ptr, SCM_SMOBNUM (smob)); @@ -592,9 +592,9 @@ scm_i_new_smob (scm_t_bits tc, scm_t_bits data) allocates a double cell. We leave words 2 and 3 to there initial values, which is 0. */ if (scm_smobs [smobnum].mark) - ret = PTR2SCM (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind)); + ret = SCM_PACK_POINTER (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind)); else - ret = PTR2SCM (GC_MALLOC (sizeof (scm_t_cell))); + ret = SCM_PACK_POINTER (GC_MALLOC (sizeof (scm_t_cell))); SCM_SET_CELL_WORD_1 (ret, data); SCM_SET_CELL_WORD_0 (ret, tc); @@ -624,9 +624,9 @@ scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1, /* Use the smob_gc_kind if needed to allow the mark procedure to run. */ if (scm_smobs [smobnum].mark) - ret = PTR2SCM (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind)); + ret = SCM_PACK_POINTER (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind)); else - ret = PTR2SCM (GC_MALLOC (2 * sizeof (scm_t_cell))); + ret = SCM_PACK_POINTER (GC_MALLOC (2 * sizeof (scm_t_cell))); SCM_SET_CELL_WORD_3 (ret, data3); SCM_SET_CELL_WORD_2 (ret, data2); diff --git a/libguile/strings.c b/libguile/strings.c index d3c8e155c..d3490a930 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -126,7 +126,7 @@ make_stringbuf (size_t len) lenhist[1000]++; #endif - buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1, + buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1, "string")); SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG); @@ -153,7 +153,7 @@ make_wide_stringbuf (size_t len) #endif raw_len = (len + 1) * sizeof (scm_t_wchar); - buf = PTR2SCM (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len, + buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len, "string")); SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG | STRINGBUF_F_WIDE); diff --git a/libguile/symbols.c b/libguile/symbols.c index 1739ac04e..498e46ce8 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -147,7 +147,7 @@ lookup_interned_latin1_symbol (const char *str, size_t len, static int symbol_lookup_predicate_fn (SCM sym, void *closure) { - SCM other = PTR2SCM (closure); + SCM other = SCM_PACK_POINTER (closure); if (scm_i_symbol_hash (sym) == scm_i_symbol_hash (other) && scm_i_symbol_length (sym) == scm_i_symbol_length (other)) @@ -184,7 +184,7 @@ scm_i_str2symbol (SCM str) the same time. */ return scm_c_weak_set_add_x (symbols, raw_hash, symbol_lookup_predicate_fn, - SCM2PTR (symbol), symbol); + SCM_UNPACK_POINTER (symbol), symbol); } } diff --git a/libguile/tags.h b/libguile/tags.h index f6d2f8d78..d5fb7e7e3 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -113,6 +113,11 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM; # define SCM_PACK(x) ((SCM) (x)) #endif +/* Packing SCM objects into and out of pointers. + */ +#define SCM_UNPACK_POINTER(x) ((scm_t_bits *) (SCM_UNPACK (x))) +#define SCM_PACK_POINTER(x) (SCM_PACK ((scm_t_bits) (x))) + /* SCM values can not be compared by using the operator ==. Use the following * macro instead, which is the equivalent of the scheme predicate 'eq?'. diff --git a/libguile/vm.c b/libguile/vm.c index 940dd6031..9958e11d7 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -228,8 +228,8 @@ vm_dispatch_hook (SCM vm, int hook_num) frame = (scm_t_cell *) ROUND_UP ((scm_t_uintptr) frame, 8UL); frame->word_0 = SCM_PACK (scm_tc7_frame); - frame->word_1 = PTR2SCM (&c_frame); - args[0] = PTR2SCM (frame); + frame->word_1 = SCM_PACK_POINTER (&c_frame); + args[0] = SCM_PACK_POINTER (frame); scm_c_run_hookn (hook, args, 1); @@ -504,7 +504,7 @@ make_vm (void) /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack top is. */ - *vp->stack_base = PTR2SCM (vp); + *vp->stack_base = SCM_PACK_POINTER (vp); vp->stack_base++; vp->stack_size--; #else diff --git a/libguile/weak-set.c b/libguile/weak-set.c index ace240ce0..4a1c835cf 100644 --- a/libguile/weak-set.c +++ b/libguile/weak-set.c @@ -654,7 +654,7 @@ weak_gc_callback (void **weak) if (!val) return 0; - callback (PTR2SCM (val)); + callback (SCM_PACK_POINTER (val)); return 1; } @@ -682,7 +682,7 @@ scm_c_register_weak_gc_callback (SCM obj, void (*callback) (SCM)) { void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2); - weak[0] = SCM2PTR (obj); + weak[0] = SCM_UNPACK_POINTER (obj); weak[1] = (void*)callback; GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj)); @@ -777,21 +777,21 @@ scm_c_weak_set_remove_x (SCM set, unsigned long raw_hash, static int eq_predicate (SCM x, void *closure) { - return scm_is_eq (x, PTR2SCM (closure)); + return scm_is_eq (x, SCM_PACK_POINTER (closure)); } SCM scm_weak_set_add_x (SCM set, SCM obj) { return scm_c_weak_set_add_x (set, scm_ihashq (obj, -1), - eq_predicate, SCM2PTR (obj), obj); + eq_predicate, SCM_UNPACK_POINTER (obj), obj); } SCM scm_weak_set_remove_x (SCM set, SCM obj) { scm_c_weak_set_remove_x (set, scm_ihashq (obj, -1), - eq_predicate, SCM2PTR (obj)); + eq_predicate, SCM_UNPACK_POINTER (obj)); return SCM_UNSPECIFIED; } @@ -837,26 +837,26 @@ scm_c_weak_set_fold (scm_t_set_fold_fn proc, void *closure, static SCM fold_trampoline (void *closure, SCM item, SCM init) { - return scm_call_2 (PTR2SCM (closure), item, init); + return scm_call_2 (SCM_PACK_POINTER (closure), item, init); } SCM scm_weak_set_fold (SCM proc, SCM init, SCM set) { - return scm_c_weak_set_fold (fold_trampoline, SCM2PTR (proc), init, set); + return scm_c_weak_set_fold (fold_trampoline, SCM_UNPACK_POINTER (proc), init, set); } static SCM for_each_trampoline (void *closure, SCM item, SCM seed) { - scm_call_1 (PTR2SCM (closure), item); + scm_call_1 (SCM_PACK_POINTER (closure), item); return seed; } SCM scm_weak_set_for_each (SCM proc, SCM set) { - scm_c_weak_set_fold (for_each_trampoline, SCM2PTR (proc), SCM_BOOL_F, set); + scm_c_weak_set_fold (for_each_trampoline, SCM_UNPACK_POINTER (proc), SCM_BOOL_F, set); return SCM_UNSPECIFIED; } @@ -864,13 +864,13 @@ scm_weak_set_for_each (SCM proc, SCM set) static SCM map_trampoline (void *closure, SCM item, SCM seed) { - return scm_cons (scm_call_1 (PTR2SCM (closure), item), seed); + return scm_cons (scm_call_1 (SCM_PACK_POINTER (closure), item), seed); } SCM scm_weak_set_map_to_list (SCM proc, SCM set) { - return scm_c_weak_set_fold (map_trampoline, SCM2PTR (proc), SCM_EOL, set); + return scm_c_weak_set_fold (map_trampoline, SCM_UNPACK_POINTER (proc), SCM_EOL, set); } diff --git a/libguile/weak-table.c b/libguile/weak-table.c index 9770d63b2..2810e0b94 100644 --- a/libguile/weak-table.c +++ b/libguile/weak-table.c @@ -754,7 +754,7 @@ weak_gc_callback (void **weak) if (!val) return 0; - callback (PTR2SCM (val)); + callback (SCM_PACK_POINTER (val)); return 1; } @@ -782,7 +782,7 @@ scm_c_register_weak_gc_callback (SCM obj, void (*callback) (SCM)) { void **weak = GC_MALLOC_ATOMIC (sizeof (void*) * 2); - weak[0] = SCM2PTR (obj); + weak[0] = SCM_UNPACK_POINTER (obj); weak[1] = (void*)callback; GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj)); @@ -877,7 +877,7 @@ scm_c_weak_table_remove_x (SCM table, unsigned long raw_hash, static int assq_predicate (SCM x, SCM y, void *closure) { - return scm_is_eq (x, PTR2SCM (closure)); + return scm_is_eq (x, SCM_PACK_POINTER (closure)); } SCM @@ -887,7 +887,7 @@ scm_weak_table_refq (SCM table, SCM key, SCM dflt) dflt = SCM_BOOL_F; return scm_c_weak_table_ref (table, scm_ihashq (key, -1), - assq_predicate, SCM2PTR (key), + assq_predicate, SCM_UNPACK_POINTER (key), dflt); } @@ -895,7 +895,7 @@ SCM scm_weak_table_putq_x (SCM table, SCM key, SCM value) { scm_c_weak_table_put_x (table, scm_ihashq (key, -1), - assq_predicate, SCM2PTR (key), + assq_predicate, SCM_UNPACK_POINTER (key), key, value); return SCM_UNSPECIFIED; } @@ -904,7 +904,7 @@ SCM scm_weak_table_remq_x (SCM table, SCM key) { scm_c_weak_table_remove_x (table, scm_ihashq (key, -1), - assq_predicate, SCM2PTR (key)); + assq_predicate, SCM_UNPACK_POINTER (key)); return SCM_UNSPECIFIED; } @@ -972,7 +972,7 @@ scm_c_weak_table_fold (scm_t_table_fold_fn proc, void *closure, static SCM fold_trampoline (void *closure, SCM k, SCM v, SCM init) { - return scm_call_3 (PTR2SCM (closure), k, v, init); + return scm_call_3 (SCM_PACK_POINTER (closure), k, v, init); } SCM @@ -982,14 +982,14 @@ scm_weak_table_fold (SCM proc, SCM init, SCM table) SCM_VALIDATE_WEAK_TABLE (3, table); SCM_VALIDATE_PROC (1, proc); - return scm_c_weak_table_fold (fold_trampoline, SCM2PTR (proc), init, table); + return scm_c_weak_table_fold (fold_trampoline, SCM_UNPACK_POINTER (proc), init, table); } #undef FUNC_NAME static SCM for_each_trampoline (void *closure, SCM k, SCM v, SCM seed) { - scm_call_2 (PTR2SCM (closure), k, v); + scm_call_2 (SCM_PACK_POINTER (closure), k, v); return seed; } @@ -1000,7 +1000,7 @@ scm_weak_table_for_each (SCM proc, SCM table) SCM_VALIDATE_WEAK_TABLE (2, table); SCM_VALIDATE_PROC (1, proc); - scm_c_weak_table_fold (for_each_trampoline, SCM2PTR (proc), SCM_BOOL_F, table); + scm_c_weak_table_fold (for_each_trampoline, SCM_UNPACK_POINTER (proc), SCM_BOOL_F, table); return SCM_UNSPECIFIED; } @@ -1009,7 +1009,7 @@ scm_weak_table_for_each (SCM proc, SCM table) static SCM map_trampoline (void *closure, SCM k, SCM v, SCM seed) { - return scm_cons (scm_call_2 (PTR2SCM (closure), k, v), seed); + return scm_cons (scm_call_2 (SCM_PACK_POINTER (closure), k, v), seed); } SCM @@ -1019,7 +1019,7 @@ scm_weak_table_map_to_list (SCM proc, SCM table) SCM_VALIDATE_WEAK_TABLE (2, table); SCM_VALIDATE_PROC (1, proc); - return scm_c_weak_table_fold (map_trampoline, SCM2PTR (proc), SCM_EOL, table); + return scm_c_weak_table_fold (map_trampoline, SCM_UNPACK_POINTER (proc), SCM_EOL, table); } #undef FUNC_NAME diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c index a42166bf5..c76ec580a 100644 --- a/libguile/weak-vector.c +++ b/libguile/weak-vector.c @@ -48,7 +48,7 @@ make_weak_vector (size_t len, SCM fill) if (SCM_UNBNDP (fill)) fill = SCM_UNSPECIFIED; - wv = PTR2SCM (scm_gc_malloc_pointerless ((len + 1) * sizeof (SCM), + wv = SCM_PACK_POINTER (scm_gc_malloc_pointerless ((len + 1) * sizeof (SCM), "weak vector")); SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect); @@ -147,7 +147,7 @@ scm_c_weak_vector_ref (SCM wv, size_t k) ret = GC_call_with_alloc_lock (weak_vector_ref, &d); if (ret) - return PTR2SCM (ret); + return SCM_PACK_POINTER (ret); else return SCM_BOOL_F; } |