[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-39-g8b33752
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-39-g8b33752 |
|
Date: |
Mon, 24 Oct 2011 17:08:12 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8b33752be7950b66bf0007e282eae3d13502f445
The branch, master has been updated
via 8b33752be7950b66bf0007e282eae3d13502f445 (commit)
via cf4c26625b901e3550c80bbf53c13189582f57a6 (commit)
via 47ed8656db8800f3ad20a40eb2c4e9ef3dc891e3 (commit)
via 8c5bb72920a41d165726a1b5a610d823971f1ca8 (commit)
via fdecb44f3252e47ee98d95f3fe473ff898ddf27e (commit)
via 21041372ed4a3c837f6d16149648508d49b4b2e2 (commit)
via dc7da0be90d6033d512f9772894179970af678e7 (commit)
via 62fdadb0a5f10ff34c7e19ac299aa89d950ffc69 (commit)
via 8c0e89ac9093aee52620bbdbec07936532f05f3d (commit)
from 633f3a18b7c6804b75ecd8ae94cf6cf82c9bcbed (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
-----------------------------------------------------------------------
Summary of changes:
libguile/alist.c | 6 ++----
libguile/array-map.c | 10 +++++-----
libguile/arrays.c | 2 +-
libguile/backtrace.c | 4 ++--
libguile/bytevectors.c | 6 +++---
libguile/bytevectors.h | 2 +-
libguile/continuations.c | 6 +++---
libguile/control.h | 2 +-
libguile/debug.c | 11 ++---------
libguile/dynwind.c | 2 +-
libguile/eval.c | 2 +-
libguile/filesys.h | 4 ++--
libguile/fluids.c | 6 +++---
libguile/fluids.h | 8 ++++----
libguile/foreign.c | 12 ++++++------
libguile/foreign.h | 3 +--
libguile/fports.h | 4 ++--
libguile/frames.h | 2 +-
libguile/gc.h | 37 +++++++++++++------------------------
libguile/gdbint.c | 4 ++--
libguile/guardians.c | 24 +++++++++++++-----------
libguile/hashtab.c | 4 ++--
libguile/hashtab.h | 2 +-
libguile/hooks.c | 8 ++++----
libguile/inline.h | 2 +-
libguile/list.c | 2 +-
libguile/load.c | 8 ++++----
libguile/macros.c | 2 +-
libguile/modules.c | 2 +-
libguile/numbers.c | 6 +++---
libguile/numbers.h | 17 ++++++++---------
libguile/objcodes.h | 2 +-
libguile/objprop.c | 4 ++--
libguile/options.c | 6 +++---
libguile/ports.c | 9 +++++----
libguile/ports.h | 20 ++++++++------------
libguile/private-gc.h | 14 +-------------
libguile/procprop.c | 21 +++++++++------------
libguile/procs.c | 19 ++++---------------
libguile/programs.h | 4 ++--
libguile/smob.c | 20 ++++++++++----------
libguile/smob.h | 2 +-
libguile/srcprop.c | 2 +-
libguile/srfi-14.h | 4 ++--
libguile/strings.c | 6 +++---
libguile/strports.h | 5 ++---
libguile/struct.c | 2 +-
libguile/symbols.c | 4 ++--
libguile/symbols.h | 5 ++---
libguile/tags.h | 24 +++++++++++++++++++++++-
libguile/validate.h | 4 ++--
libguile/variable.h | 4 ++--
libguile/vectors.h | 4 ++--
libguile/vm-i-system.c | 6 +++---
libguile/vm.c | 6 +++---
libguile/vm.h | 4 ++--
libguile/weak-set.c | 36 ++++++++++++++++++------------------
libguile/weak-table.c | 40 ++++++++++++++++++++--------------------
libguile/weak-vector.c | 12 ++++++------
libguile/weak-vector.h | 2 +-
60 files changed, 236 insertions(+), 265 deletions(-)
diff --git a/libguile/alist.c b/libguile/alist.c
index fd2ccde..799e9f1 100644
--- a/libguile/alist.c
+++ b/libguile/alist.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2004, 2006, 2008, 2010 Free
Software Foundation, Inc.
+/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001, 2004, 2006, 2008, 2010,
2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -40,9 +40,7 @@ SCM_DEFINE (scm_acons, "acons", 3, 0, 0,
"function is @emph{not} destructive; @var{alist} is not modified.")
#define FUNC_NAME s_scm_acons
{
- return scm_cell (SCM_UNPACK (scm_cell (SCM_UNPACK (key),
- SCM_UNPACK (value))),
- SCM_UNPACK (alist));
+ return scm_cons (scm_cons (key, value), alist);
}
#undef FUNC_NAME
diff --git a/libguile/array-map.c b/libguile/array-map.c
index d442bdf..395fa11 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009, 2010 Free
Software Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -99,7 +99,7 @@ scm_ra_matchp (SCM ra0, SCM ras)
else
return 0;
- while (SCM_NIMP (ras))
+ while (scm_is_pair (ras))
{
ra1 = SCM_CAR (ras);
@@ -204,7 +204,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra,
const char *what)
}
lvra = SCM_EOL;
plvra = &lvra;
- for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
+ for (z = lra; scm_is_pair (z); z = SCM_CDR (z))
{
ra1 = SCM_CAR (z);
vra1 = scm_i_make_array (1);
@@ -262,7 +262,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra,
const char *what)
}
lvra = SCM_EOL;
plvra = &lvra;
- for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
+ for (z = lra; scm_is_pair (z); z = SCM_CDR (z))
{
ra1 = SCM_CAR (z);
vra1 = scm_i_make_array (1);
@@ -295,7 +295,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra,
const char *what)
{
SCM y = lra;
SCM_I_ARRAY_BASE (vra0) = cind (ra0, vinds);
- for (z = lvra; SCM_NIMP (z); z = SCM_CDR (z), y = SCM_CDR (y))
+ for (z = lvra; scm_is_pair (z); z = SCM_CDR (z), y = SCM_CDR (y))
SCM_I_ARRAY_BASE (SCM_CAR (z)) = cind (SCM_CAR (y), vinds);
if (0 == (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data,
lvra)))
return 0;
diff --git a/libguile/arrays.c b/libguile/arrays.c
index d99081c..cc5c726 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -472,7 +472,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
int ndim, i, k;
SCM_VALIDATE_REST_ARGUMENT (args);
- SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
+ SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME);
if (scm_is_generalized_vector (ra))
{
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index db22c17..a9b37fd 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 8fc0252..9999b23 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);
@@ -333,7 +333,7 @@ scm_c_shrink_bytevector (SCM bv, size_t c_new_len)
SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
if (SCM_BYTEVECTOR_CONTIGUOUS_P (bv))
- new_bv = PTR2SCM (scm_gc_realloc (SCM2PTR (bv),
+ new_bv = SCM_PACK_POINTER (scm_gc_realloc (SCM_HEAP_OBJECT_BASE (bv),
c_len + SCM_BYTEVECTOR_HEADER_BYTES,
c_new_len + SCM_BYTEVECTOR_HEADER_BYTES,
SCM_GC_BYTEVECTOR));
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index f22a3dd..a5eeaea 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -117,7 +117,7 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
/* Internal API. */
#define SCM_BYTEVECTOR_P(x) \
- (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_bytevector)
+ (SCM_HAS_TYP7 (x, scm_tc7_bytevector))
#define SCM_BYTEVECTOR_FLAGS(_bv) \
(SCM_CELL_TYPE (_bv) >> 7UL)
#define SCM_SET_BYTEVECTOR_FLAGS(_bv, _f) \
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 7e20966..7a842de 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/control.h b/libguile/control.h
index 2167ffa..ebf255f 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -22,7 +22,7 @@
#define SCM_F_PROMPT_ESCAPE 0x1
-#define SCM_PROMPT_P(x) (!SCM_IMP (x) && SCM_TYP7(x) ==
scm_tc7_prompt)
+#define SCM_PROMPT_P(x) (SCM_HAS_TYP7 (x, scm_tc7_prompt))
#define SCM_PROMPT_FLAGS(x) (SCM_CELL_WORD ((x), 0) >> 8)
#define SCM_PROMPT_ESCAPE_P(x) (SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_ESCAPE)
#define SCM_PROMPT_TAG(x) (SCM_CELL_OBJECT ((x), 1))
diff --git a/libguile/debug.c b/libguile/debug.c
index 1a5c197..c6ce99e 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -144,16 +144,9 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1,
0, 0,
if (scm_is_true (src))
return src;
- switch (SCM_TYP7 (proc)) {
- case scm_tcs_struct:
- if (!SCM_STRUCT_APPLICABLE_P (proc)
- || SCM_IMP (SCM_STRUCT_PROCEDURE (proc)))
- break;
- proc = SCM_STRUCT_PROCEDURE (proc);
+ if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc)
+ && SCM_HEAP_OBJECT_P ((proc = SCM_STRUCT_PROCEDURE (proc))))
continue;
- default:
- break;
- }
}
while (0);
diff --git a/libguile/dynwind.c b/libguile/dynwind.c
index 14dd861..bec2dc8 100644
--- a/libguile/dynwind.c
+++ b/libguile/dynwind.c
@@ -195,7 +195,7 @@ void
scm_swap_bindings (SCM vars, SCM vals)
{
SCM tmp;
- while (SCM_NIMP (vals))
+ while (scm_is_pair (vals))
{
tmp = SCM_VARIABLE_REF (SCM_CAR (vars));
SCM_VARIABLE_SET (SCM_CAR (vars), SCM_CAR (vals));
diff --git a/libguile/eval.c b/libguile/eval.c
index e1d0348..f73710a 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -914,7 +914,7 @@ boot_closure_print (SCM closure, SCM port, scm_print_state
*pstate)
{
SCM args;
scm_puts ("#<boot-closure ", port);
- scm_uintprint ((scm_t_bits)SCM2PTR (closure), 16, port);
+ scm_uintprint (SCM_UNPACK (closure), 16, port);
scm_putc (' ', port);
args = scm_make_list (scm_from_int (BOOT_CLOSURE_NUM_REQUIRED_ARGS
(closure)),
scm_from_latin1_symbol ("_"));
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 967ce74..c420992 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -3,7 +3,7 @@
#ifndef SCM_FILESYS_H
#define SCM_FILESYS_H
-/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -31,7 +31,7 @@ SCM_API scm_t_bits scm_tc16_dir;
#define SCM_DIR_FLAG_OPEN (1L << 0)
-#define SCM_DIRP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_dir))
+#define SCM_DIRP(x) (SCM_HAS_TYP16 (x, scm_tc16_dir))
#define SCM_DIR_OPEN_P(x) (SCM_SMOB_FLAGS (x) & SCM_DIR_FLAG_OPEN)
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 67efd9f..661f06c 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,11 +156,11 @@ 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],
- SCM2PTR (fluid));
+ SCM_HEAP_OBJECT_BASE (fluid));
scm_dynwind_end ();
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 66e3985..09de736 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -3,7 +3,7 @@
#ifndef SCM_FLUIDS_H
#define SCM_FLUIDS_H
-/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010 Free Software
Foundation, Inc.
+/* Copyright (C) 1996,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -32,7 +32,7 @@
always in the same place for a given thread, in the dynamic-state vector.
*/
-#define SCM_WITH_FLUIDS_P(x) (!SCM_IMP (x) && SCM_TYP7(x) ==
scm_tc7_with_fluids)
+#define SCM_WITH_FLUIDS_P(x) (SCM_HAS_TYP7 (x, scm_tc7_with_fluids))
#define SCM_WITH_FLUIDS_LEN(x) (SCM_CELL_WORD ((x), 0) >> 8)
#define SCM_WITH_FLUIDS_NTH_FLUID(x,n) (SCM_CELL_OBJECT ((x), 1 + (n)*2))
#define SCM_WITH_FLUIDS_NTH_VAL(x,n) (SCM_CELL_OBJECT ((x), 2 + (n)*2))
@@ -54,7 +54,7 @@
grow.
*/
-#define SCM_FLUID_P(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_fluid)
+#define SCM_FLUID_P(x) (SCM_HAS_TYP7 (x, scm_tc7_fluid))
#ifdef BUILDING_LIBGUILE
#define SCM_I_FLUID_NUM(x) ((size_t)SCM_CELL_WORD_1(x))
#endif
@@ -81,7 +81,7 @@ SCM_API SCM scm_with_fluid (SCM fluid, SCM val, SCM thunk);
SCM_API void scm_dynwind_fluid (SCM fluid, SCM value);
#ifdef BUILDING_LIBGUILE
-#define SCM_I_DYNAMIC_STATE_P(x) (!SCM_IMP (x) && SCM_TYP7 (x) ==
scm_tc7_dynamic_state)
+#define SCM_I_DYNAMIC_STATE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_dynamic_state))
#define SCM_I_DYNAMIC_STATE_FLUIDS(x) SCM_PACK (SCM_CELL_WORD_1 (x))
#endif
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 2a11fb0..e431c50 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,
@@ -152,7 +152,7 @@ scm_from_pointer (void *ptr, scm_t_pointer_finalizer
finalizer)
/* Register a finalizer for the newly created instance. */
GC_finalization_proc prev_finalizer;
GC_PTR prev_finalizer_data;
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (ret),
pointer_finalizer_trampoline,
finalizer,
&prev_finalizer,
@@ -195,7 +195,7 @@ SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0,
SCM ret;
ret = scm_from_pointer ((void*) SCM_UNPACK (scm), NULL);
- if (SCM_NIMP (ret))
+ if (SCM_HEAP_OBJECT_P (ret))
register_weak_reference (ret, scm);
return ret;
@@ -317,7 +317,7 @@ SCM_DEFINE (scm_set_pointer_finalizer_x,
"set-pointer-finalizer!", 2, 0, 0,
SCM_SET_CELL_WORD_0 (pointer, SCM_CELL_WORD_0 (pointer) | (1 << 16UL));
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (pointer),
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (pointer),
pointer_finalizer_trampoline,
c_finalizer,
&prev_finalizer,
@@ -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/foreign.h b/libguile/foreign.h
index 6c6f373..eac4ca0 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -49,8 +49,7 @@ typedef enum scm_t_foreign_type scm_t_foreign_type;
typedef void (*scm_t_pointer_finalizer) (void *);
-#define SCM_POINTER_P(x) \
- (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_pointer)
+#define SCM_POINTER_P(x) (SCM_HAS_TYP7 (x, scm_tc7_pointer))
#define SCM_VALIDATE_POINTER(pos, x) \
SCM_MAKE_VALIDATE (pos, x, POINTER_P)
#define SCM_POINTER_VALUE(x) \
diff --git a/libguile/fports.h b/libguile/fports.h
index cbef0f8..32b6a59 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,7 +3,7 @@
#ifndef SCM_FPORTS_H
#define SCM_FPORTS_H
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2011
Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -39,7 +39,7 @@ SCM_API scm_t_bits scm_tc16_fport;
#define SCM_FSTREAM(x) ((scm_t_fport *) SCM_STREAM (x))
#define SCM_FPORT_FDES(x) (SCM_FSTREAM (x)->fdes)
-#define SCM_FPORTP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_fport))
+#define SCM_FPORTP(x) (SCM_HAS_TYP16 (x, scm_tc16_fport))
#define SCM_OPFPORTP(x) (SCM_FPORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_OPN))
#define SCM_OPINFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) &
SCM_RDNG))
#define SCM_OPOUTFPORTP(x) (SCM_OPFPORTP (x) && (SCM_CELL_WORD_0 (x) &
SCM_WRTNG))
diff --git a/libguile/frames.h b/libguile/frames.h
index 47244c7..7b9af76 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -96,7 +96,7 @@ struct scm_frame
scm_t_ptrdiff offset;
};
-#define SCM_VM_FRAME_P(x) (SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_frame)
+#define SCM_VM_FRAME_P(x) (SCM_HAS_TYP7 (x, scm_tc7_frame))
#define SCM_VM_FRAME_DATA(x) ((struct scm_frame*)SCM_CELL_WORD_1 (x))
#define SCM_VM_FRAME_STACK_HOLDER(f) SCM_VM_FRAME_DATA(f)->stack_holder
#define SCM_VM_FRAME_FP(f) SCM_VM_FRAME_DATA(f)->fp
diff --git a/libguile/gc.h b/libguile/gc.h
index f062942..a7f3b73 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
@@ -58,12 +45,13 @@ typedef struct scm_t_cell
* in debug mode. In particular these macros will even work for free cells,
* which should never be encountered by user code. */
-#define SCM_GC_CELL_OBJECT(x, n) (((SCM *)SCM2PTR (x)) [n])
-#define SCM_GC_CELL_WORD(x, n) (SCM_UNPACK (SCM_GC_CELL_OBJECT ((x), (n))))
+#define SCM_GC_CELL_OBJECT(x, n) (SCM_PACK (SCM_HEAP_OBJECT_BASE (x)[n]))
+#define SCM_GC_CELL_WORD(x, n) (SCM_HEAP_OBJECT_BASE (x)[n])
-#define SCM_GC_SET_CELL_OBJECT(x, n, v) ((((SCM *)SCM2PTR (x)) [n]) = (v))
+#define SCM_GC_SET_CELL_OBJECT(x, n, v) \
+ (SCM_HEAP_OBJECT_BASE (x)[n] = SCM_UNPACK (v))
#define SCM_GC_SET_CELL_WORD(x, n, v) \
- (SCM_GC_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
+ (SCM_HEAP_OBJECT_BASE (x)[n] = (v))
#define SCM_GC_CELL_TYPE(x) (SCM_GC_CELL_OBJECT ((x), 0))
@@ -109,7 +97,8 @@ typedef struct scm_t_cell
#define SCM_SET_CELL_OBJECT_2(x, v) SCM_SET_CELL_OBJECT ((x), 2, (v))
#define SCM_SET_CELL_OBJECT_3(x, v) SCM_SET_CELL_OBJECT ((x), 3, (v))
-#define SCM_CELL_OBJECT_LOC(x, n) (SCM_VALIDATE_CELL((x), &SCM_GC_CELL_OBJECT
((x), (n))))
+#define SCM_CELL_WORD_LOC(x, n) (SCM_VALIDATE_CELL((x), &SCM_GC_CELL_WORD
((x), (n))))
+#define SCM_CELL_OBJECT_LOC(x, n) ((SCM *) SCM_CELL_WORD_LOC (x, n))
#define SCM_CARLOC(x) (SCM_CELL_OBJECT_LOC ((x), 0))
#define SCM_CDRLOC(x) (SCM_CELL_OBJECT_LOC ((x), 1))
@@ -212,7 +201,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 +219,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 +258,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/gdbint.c b/libguile/gdbint.c
index 77fdbd1..196c498 100644
--- a/libguile/gdbint.c
+++ b/libguile/gdbint.c
@@ -158,7 +158,7 @@ gdb_read (char *str)
ans = scm_read (gdb_input_port);
if (SCM_GC_P)
{
- if (SCM_NIMP (ans))
+ if (SCM_HEAP_OBJECT_P (ans))
{
SEND_STRING ("Non-immediate created during gc. Memory may be
trashed.");
status = -1;
@@ -167,7 +167,7 @@ gdb_read (char *str)
}
gdb_result = ans;
/* Protect answer from future GC (FIXME: still needed with BDW-GC?) */
- if (SCM_NIMP (ans))
+ if (SCM_HEAP_OBJECT_P (ans))
scm_permanent_object (ans);
exit:
remark_port (gdb_input_port);
diff --git a/libguile/guardians.c b/libguile/guardians.c
index 076df00..dfc5332 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 ();
@@ -193,7 +193,7 @@ scm_i_guard (SCM guardian, SCM obj)
{
t_guardian *g = GUARDIAN_DATA (guardian);
- if (SCM_NIMP (obj))
+ if (SCM_HEAP_OBJECT_P (obj))
{
/* Register a finalizer and pass a pair as the ``client data''
argument. The pair contains in its car `#f' or a pair describing a
@@ -218,8 +218,10 @@ 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),
+ /* FIXME: should be SCM_HEAP_OBJECT_BASE, but will the finalizer
+ strip the tag bits of pairs or structs? */
+ 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 +233,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 +250,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 1f1f69c..55f0881 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/hashtab.h b/libguile/hashtab.h
index fdd746c..8eb685a 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -27,7 +27,7 @@
-#define SCM_HASHTABLE_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_hashtable)
+#define SCM_HASHTABLE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_hashtable))
#define SCM_VALIDATE_HASHTABLE(pos, arg) \
SCM_MAKE_VALIDATE_MSG (pos, arg, HASHTABLE_P, "hash-table")
#define SCM_HASHTABLE_VECTOR(h) SCM_CELL_OBJECT_1 (h)
diff --git a/libguile/hooks.c b/libguile/hooks.c
index abba606..14335f8 100644
--- a/libguile/hooks.c
+++ b/libguile/hooks.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008, 2009 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008, 2009, 2011
Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -139,7 +139,7 @@ hook_print (SCM hook, SCM port, scm_print_state *pstate)
scm_putc (' ', port);
scm_uintprint (SCM_UNPACK (hook), 16, port);
ls = SCM_HOOK_PROCEDURES (hook);
- while (SCM_NIMP (ls))
+ while (scm_is_pair (ls))
{
scm_putc (' ', port);
name = scm_procedure_name (SCM_CAR (ls));
@@ -269,7 +269,7 @@ void
scm_c_run_hook (SCM hook, SCM args)
{
SCM procs = SCM_HOOK_PROCEDURES (hook);
- while (SCM_NIMP (procs))
+ while (scm_is_pair (procs))
{
scm_apply_0 (SCM_CAR (procs), args);
procs = SCM_CDR (procs);
@@ -280,7 +280,7 @@ void
scm_c_run_hookn (SCM hook, SCM *argv, size_t nargs)
{
SCM procs = SCM_HOOK_PROCEDURES (hook);
- while (SCM_NIMP (procs))
+ while (scm_is_pair (procs))
{
scm_call_n (SCM_CAR (procs), argv, nargs);
procs = SCM_CDR (procs);
diff --git a/libguile/inline.h b/libguile/inline.h
index 6b1cf5e..315240e 100644
--- a/libguile/inline.h
+++ b/libguile/inline.h
@@ -111,7 +111,7 @@ scm_is_pair (SCM x)
SCM_INLINE_IMPLEMENTATION int
scm_is_string (SCM x)
{
- return SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_string);
+ return SCM_HAS_TYP7 (x, scm_tc7_string);
}
/* Port I/O. */
diff --git a/libguile/list.c b/libguile/list.c
index 221ee79..8297b17 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -90,7 +90,7 @@ scm_list_n (SCM elt, ...)
while (! SCM_UNBNDP (elt))
{
#if (SCM_DEBUG_CELL_ACCESSES == 1)
- if (SCM_NIMP (elt))
+ if (SCM_HEAP_OBJECT_P (elt))
SCM_VALIDATE_CELL(elt, 0);
#endif
*pos = scm_cons (elt, SCM_EOL);
diff --git a/libguile/load.c b/libguile/load.c
index 21008cb..c6e6887 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/macros.c b/libguile/macros.c
index 556e60f..bf351e4 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -103,7 +103,7 @@ SCM_DEFINE (scm_make_syntax_transformer,
"make-syntax-transformer", 3, 0, 0,
SCM_VALIDATE_SYMBOL (2, type);
z = scm_words (scm_tc16_macro, 5);
- SCM_SET_SMOB_DATA_N (z, 1, prim);
+ SCM_SET_SMOB_DATA_N (z, 1, (scm_t_bits)prim);
SCM_SET_SMOB_OBJECT_N (z, 2, name);
SCM_SET_SMOB_OBJECT_N (z, 3, type);
SCM_SET_SMOB_OBJECT_N (z, 4, binding);
diff --git a/libguile/modules.c b/libguile/modules.c
index 971676c..63268fb 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -695,7 +695,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
{
SCM var;
- if (SCM_NIMP (proc))
+ if (SCM_HEAP_OBJECT_P (proc))
{
if (SCM_EVAL_CLOSURE_P (proc))
{
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 19673b8..96e1765 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/numbers.h b/libguile/numbers.h
index d3a3444..96843c1 100644
--- a/libguile/numbers.h
+++ b/libguile/numbers.h
@@ -125,22 +125,21 @@ typedef scm_t_int32 scm_t_wchar;
#define SCM_INEXACTP(x) \
(!SCM_IMP (x) && (0xfeff & SCM_CELL_TYPE (x)) == scm_tc16_real)
-#define SCM_REALP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_real)
-#define SCM_COMPLEXP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_complex)
+#define SCM_REALP(x) (SCM_HAS_TYP16 (x, scm_tc16_real))
+#define SCM_COMPLEXP(x) (SCM_HAS_TYP16 (x, scm_tc16_complex))
-#define SCM_REAL_VALUE(x) (((scm_t_double *) SCM2PTR (x))->real)
-#define SCM_COMPLEX_REAL(x) (((scm_t_complex *) SCM2PTR (x))->real)
-#define SCM_COMPLEX_IMAG(x) (((scm_t_complex *) SCM2PTR (x))->imag)
+#define SCM_REAL_VALUE(x) (((scm_t_double *) SCM_HEAP_OBJECT_BASE (x))->real)
+#define SCM_COMPLEX_REAL(x) (((scm_t_complex *) SCM_HEAP_OBJECT_BASE
(x))->real)
+#define SCM_COMPLEX_IMAG(x) (((scm_t_complex *) SCM_HEAP_OBJECT_BASE
(x))->imag)
/* Each bignum is just an mpz_t stored in a double cell starting at word 1. */
#define SCM_I_BIG_MPZ(x) (*((mpz_t *) (SCM_CELL_OBJECT_LOC((x),1))))
-#define SCM_BIGP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_big)
+#define SCM_BIGP(x) (SCM_HAS_TYP16 (x, scm_tc16_big))
#define SCM_NUMBERP(x) (SCM_I_INUMP(x) || SCM_NUMP(x))
-#define SCM_NUMP(x) (!SCM_IMP(x) \
- && ((0x00ff & SCM_CELL_TYPE (x)) == scm_tc7_number))
+#define SCM_NUMP(x) (SCM_HAS_TYP7 (x, scm_tc7_number))
-#define SCM_FRACTIONP(x) (!SCM_IMP (x) && SCM_TYP16 (x) == scm_tc16_fraction)
+#define SCM_FRACTIONP(x) (SCM_HAS_TYP16 (x, scm_tc16_fraction))
#define SCM_FRACTION_NUMERATOR(x) (SCM_CELL_OBJECT_1 (x))
#define SCM_FRACTION_DENOMINATOR(x) (SCM_CELL_OBJECT_2 (x))
diff --git a/libguile/objcodes.h b/libguile/objcodes.h
index 2fc43d5..c075c5c 100644
--- a/libguile/objcodes.h
+++ b/libguile/objcodes.h
@@ -40,7 +40,7 @@ struct scm_objcode
#define SCM_OBJCODE_TYPE_SLICE (2)
#define SCM_OBJCODE_TYPE_STATIC (3)
-#define SCM_OBJCODE_P(x) (SCM_NIMP (x) && SCM_TYP7 (x) ==
scm_tc7_objcode)
+#define SCM_OBJCODE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_objcode))
#define SCM_OBJCODE_DATA(x) ((struct scm_objcode *) SCM_CELL_WORD_1 (x))
#define SCM_VALIDATE_OBJCODE(p,x) SCM_MAKE_VALIDATE (p, x, OBJCODE_P)
diff --git a/libguile/objprop.c b/libguile/objprop.c
index 3a57d28..b45c9aa 100644
--- a/libguile/objprop.c
+++ b/libguile/objprop.c
@@ -64,7 +64,7 @@ SCM_DEFINE (scm_object_property, "object-property", 2, 0, 0,
{
SCM assoc;
assoc = scm_assq (key, scm_object_properties (obj));
- return (SCM_NIMP (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
+ return (scm_is_pair (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
}
#undef FUNC_NAME
@@ -80,7 +80,7 @@ SCM_DEFINE (scm_set_object_property_x,
"set-object-property!", 3, 0, 0,
scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
alist = scm_weak_table_refq (object_whash, obj, SCM_EOL);
assoc = scm_assq (key, alist);
- if (SCM_NIMP (assoc))
+ if (scm_is_pair (assoc))
SCM_SETCDR (assoc, value);
else
scm_weak_table_putq_x (object_whash, obj, scm_acons (key, value, alist));
diff --git a/libguile/options.c b/libguile/options.c
index 0e08314..286d9e1 100644
--- a/libguile/options.c
+++ b/libguile/options.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010 Free
Software Foundation
+/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010, 2011 Free
Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -231,9 +231,9 @@ change_option_setting (SCM args, scm_t_option options[],
const char *s,
{
SCM old = SCM_PACK (options[i].val);
SCM new = SCM_PACK (flags[i]);
- if (!SCM_IMP (old))
+ if (SCM_HEAP_OBJECT_P (old))
protected_objects = scm_delq1_x (old, protected_objects);
- if (!SCM_IMP (new))
+ if (SCM_HEAP_OBJECT_P (new))
protected_objects = scm_cons (new, protected_objects);
}
options[i].val = flags[i];
diff --git a/libguile/ports.c b/libguile/ports.c
index 6c4561e..b6b3aa9 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -525,7 +525,8 @@ register_finalizer_for_port (SCM port)
/* Register a finalizer for PORT so that its iconv CDs get freed and
optionally its type's `free' function gets called. */
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (port), finalize_port, 0,
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (port),
+ finalize_port, 0,
&prev_finalizer,
&prev_finalization_data);
}
@@ -535,7 +536,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 +878,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 +893,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/ports.h b/libguile/ports.h
index f5c98ab..f8bff35 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -138,18 +138,14 @@ SCM_INTERNAL SCM scm_i_port_weak_set;
#define SCM_BUF0 (8L<<16) /* Is it unbuffered? */
#define SCM_BUFLINE (64L<<16) /* Is it line-buffered? */
-#define SCM_PORTP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_port))
-#define SCM_OPPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN) &
SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN)))
-#define SCM_OPINPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) &
SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG)))
-#define SCM_OPOUTPORTP(x) (!SCM_IMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) &
SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG)))
-#define SCM_INPUT_PORT_P(x) \
- (!SCM_IMP(x) \
- && (((0x7f | SCM_RDNG) & SCM_CELL_WORD_0(x)) == (scm_tc7_port | SCM_RDNG)))
-#define SCM_OUTPUT_PORT_P(x) \
- (!SCM_IMP(x) \
- && (((0x7f | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_WRTNG)))
-#define SCM_OPENP(x) (!SCM_IMP(x) && (SCM_OPN & SCM_CELL_WORD_0 (x)))
-#define SCM_CLOSEDP(x) (!SCM_OPENP(x))
+#define SCM_PORTP(x) (SCM_HAS_TYP7 (x, scm_tc7_port))
+#define SCM_OPPORTP(x) (SCM_PORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_OPN))
+#define SCM_INPUT_PORT_P(x) (SCM_PORTP (x) && (SCM_CELL_WORD_0 (x) & SCM_RDNG))
+#define SCM_OUTPUT_PORT_P(x) (SCM_PORTP (x) && (SCM_CELL_WORD_0 (x) &
SCM_WRTNG))
+#define SCM_OPINPORTP(x) (SCM_OPPORTP (x) && SCM_INPUT_PORT_P (x))
+#define SCM_OPOUTPORTP(x) (SCM_OPPORTP (x) && SCM_OUTPUT_PORT_P (x))
+#define SCM_OPENP(x) (SCM_OPPORTP (x))
+#define SCM_CLOSEDP(x) (!SCM_OPENP (x))
#define SCM_CLR_PORT_OPEN_FLAG(p) \
SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN)
diff --git a/libguile/private-gc.h b/libguile/private-gc.h
index 42514c1..4c691dd 100644
--- a/libguile/private-gc.h
+++ b/libguile/private-gc.h
@@ -1,7 +1,7 @@
/*
* private-gc.h - private declarations for garbage collection.
*
- * Copyright (C) 2002, 03, 04, 05, 06, 07, 08, 09 Free Software Foundation,
Inc.
+ * Copyright (C) 2002, 03, 04, 05, 06, 07, 08, 09, 11 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -49,18 +49,6 @@ typedef enum { return_on_error, abort_on_error }
policy_on_error;
#define SCM_MAX(A, B) ((A) > (B) ? (A) : (B))
#define SCM_MIN(A, B) ((A) < (B) ? (A) : (B))
-/* CELL_P checks a random word whether it has the right form for a
- pointer to a cell. Use scm_i_find_heap_segment_containing_object
- to find out whether it actually points to a real cell.
-
- The right form for a cell pointer is this: the low three bits must
- be scm_tc3_cons, and when the scm_tc3_cons tag is stripped, the
- resulting pointer must be correctly aligned.
- scm_i_initialize_heap_segment_data guarantees that the test below
- works.
-*/
-#define CELL_P(x) ((SCM_UNPACK(x) & (sizeof(scm_t_cell)-1)) == scm_tc3_cons)
-
SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */
#endif
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 8d5b162..2ad941d 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -48,23 +48,20 @@ scm_i_procedure_arity (SCM proc, int *req, int *opt, int
*rest)
{
while (!SCM_PROGRAM_P (proc))
{
- if (SCM_IMP (proc))
- return 0;
- switch (SCM_TYP7 (proc))
+ if (SCM_STRUCTP (proc))
{
- case scm_tc7_smob:
- if (!SCM_SMOB_APPLICABLE_P (proc))
- return 0;
- proc = scm_i_smob_apply_trampoline (proc);
- break;
- case scm_tcs_struct:
if (!SCM_STRUCT_APPLICABLE_P (proc))
return 0;
proc = SCM_STRUCT_PROCEDURE (proc);
- break;
- default:
- return 0;
}
+ else if (SCM_HAS_TYP7 (proc, scm_tc7_smob))
+ {
+ if (!SCM_SMOB_APPLICABLE_P (proc))
+ return 0;
+ proc = scm_i_smob_apply_trampoline (proc);
+ }
+ else
+ return 0;
}
return scm_i_program_arity (proc, req, opt, rest);
}
diff --git a/libguile/procs.c b/libguile/procs.c
index 0018dc9..7a2f491 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -46,21 +46,10 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
"Return @code{#t} if @var{obj} is a procedure.")
#define FUNC_NAME s_scm_procedure_p
{
- if (SCM_NIMP (obj))
- switch (SCM_TYP7 (obj))
- {
- case scm_tcs_struct:
- if (!((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_PURE_GENERIC)
- || SCM_STRUCT_APPLICABLE_P (obj)))
- break;
- case scm_tc7_program:
- return SCM_BOOL_T;
- case scm_tc7_smob:
- return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply);
- default:
- return SCM_BOOL_F;
- }
- return SCM_BOOL_F;
+ return scm_from_bool (SCM_PROGRAM_P (obj)
+ || (SCM_STRUCTP (obj) && SCM_STRUCT_APPLICABLE_P (obj))
+ || (SCM_HAS_TYP7 (obj, scm_tc7_smob)
+ && SCM_SMOB_APPLICABLE_P (obj)));
}
#undef FUNC_NAME
diff --git a/libguile/programs.h b/libguile/programs.h
index d0e788e..d53fd8f 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -32,7 +32,7 @@
#define SCM_F_PROGRAM_IS_CONTINUATION 0x800
#define SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION 0x1000
-#define SCM_PROGRAM_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program)
+#define SCM_PROGRAM_P(x) (SCM_HAS_TYP7 (x, scm_tc7_program))
#define SCM_PROGRAM_OBJCODE(x) (SCM_CELL_OBJECT_1 (x))
#define SCM_PROGRAM_OBJTABLE(x) (SCM_CELL_OBJECT_2 (x))
#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_LOC (x, 3))
diff --git a/libguile/smob.c b/libguile/smob.c
index ab8208c..ad58301 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
@@ -516,7 +516,7 @@ smob_mark (GC_word *addr, struct GC_ms_entry
*mark_stack_ptr,
mark_stack_ptr = SCM_I_CURRENT_THREAD->current_mark_stack_ptr;
- if (SCM_NIMP (obj))
+ if (SCM_HEAP_OBJECT_P (obj))
/* Mark the returned object. */
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (obj),
mark_stack_ptr,
@@ -541,7 +541,7 @@ scm_gc_mark (SCM o)
#define CURRENT_MARK_LIMIT \
((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
- if (SCM_NIMP (o))
+ if (SCM_HEAP_OBJECT_P (o))
{
/* At this point, the `current_mark_*' fields of the current thread
must be defined (they are set in `smob_mark ()'). */
@@ -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);
@@ -604,7 +604,7 @@ scm_i_new_smob (scm_t_bits tc, scm_t_bits data)
GC_finalization_proc prev_finalizer;
GC_PTR prev_finalizer_data;
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (ret),
finalize_smob, NULL,
&prev_finalizer, &prev_finalizer_data);
}
@@ -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);
@@ -638,7 +638,7 @@ scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1,
GC_finalization_proc prev_finalizer;
GC_PTR prev_finalizer_data;
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (ret),
finalize_smob, NULL,
&prev_finalizer, &prev_finalizer_data);
}
diff --git a/libguile/smob.h b/libguile/smob.h
index 1bcece6..be404a8 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -50,7 +50,7 @@ typedef struct scm_smob_descriptor
#define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CELL_TYPE (x)))
/* SCM_SMOBNAME can be 0 if name is missing */
#define SCM_SMOBNAME(smobnum) (scm_smobs[smobnum].name)
-#define SCM_SMOB_PREDICATE(tag, obj) SCM_TYP16_PREDICATE (tag, obj)
+#define SCM_SMOB_PREDICATE(tag, obj) SCM_HAS_TYP16 (obj, tag)
#define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)])
#define SCM_SMOB_APPLICABLE_P(x) (SCM_SMOB_DESCRIPTOR (x).apply)
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index cd16789..9f07498 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -245,7 +245,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
p = SRCPROPALIST (p);
alist:
p = scm_assoc (key, p);
- return (SCM_NIMP (p) ? SCM_CDR (p) : SCM_BOOL_F);
+ return (scm_is_pair (p) ? SCM_CDR (p) : SCM_BOOL_F);
}
return SCM_UNBNDP (p) ? SCM_BOOL_F : p;
}
diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h
index 4b1a4b2..dc9718d 100644
--- a/libguile/srfi-14.h
+++ b/libguile/srfi-14.h
@@ -3,7 +3,7 @@
/* srfi-14.c --- SRFI-14 procedures for Guile
*
- * Copyright (C) 2001, 2004, 2006, 2008 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2006, 2008, 2011 Free Software Foundation,
Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -45,7 +45,7 @@ typedef struct
#define SCM_CHARSET_GET(cs,idx) \
scm_i_charset_get((scm_t_char_set *)SCM_SMOB_DATA(cs),idx)
-#define SCM_CHARSETP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_charset))
+#define SCM_CHARSETP(x) (SCM_HAS_TYP16 (x, scm_tc16_charset))
/* Smob type code for character sets. */
SCM_API int scm_tc16_charset;
diff --git a/libguile/strings.c b/libguile/strings.c
index 2de0035..d3490a9 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);
@@ -240,7 +240,7 @@ scm_i_pthread_mutex_t stringbuf_write_mutex =
SCM_I_PTHREAD_MUTEX_INITIALIZER;
#define SET_STRING_STRINGBUF(str,buf) (SCM_SET_CELL_OBJECT_1(str,buf))
#define SET_STRING_START(str,start) (SCM_SET_CELL_WORD_2(str,start))
-#define IS_STRING(str) (SCM_NIMP(str) && SCM_TYP7(str) == STRING_TAG)
+#define IS_STRING(str) (SCM_HAS_TYP7 (str, STRING_TAG))
/* Read-only strings.
*/
diff --git a/libguile/strports.h b/libguile/strports.h
index 3a9c3ec..b4bafdf 100644
--- a/libguile/strports.h
+++ b/libguile/strports.h
@@ -3,7 +3,7 @@
#ifndef SCM_STRPORTS_H
#define SCM_STRPORTS_H
-/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010 Free Software
Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010, 2011 Free
Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -28,8 +28,7 @@
-#define SCM_STRPORTP(x) (!SCM_IMP (x) && \
- (SCM_TYP16 (x) == scm_tc16_strport))
+#define SCM_STRPORTP(x) (SCM_HAS_TYP16 (x, scm_tc16_strport))
#define SCM_OPSTRPORTP(x) (SCM_STRPORTP (x) && \
(SCM_CELL_WORD_0 (x) & SCM_OPN))
#define SCM_OPINSTRPORTP(x) (SCM_OPSTRPORTP (x) && \
diff --git a/libguile/struct.c b/libguile/struct.c
index 7f8f75d..cb046a1 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -446,7 +446,7 @@ scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words)
/* Register a finalizer for the newly created instance. */
GC_finalization_proc prev_finalizer;
GC_PTR prev_finalizer_data;
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (ret),
struct_finalizer_trampoline,
NULL,
&prev_finalizer,
diff --git a/libguile/symbols.c b/libguile/symbols.c
index 1739ac0..498e46c 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/symbols.h b/libguile/symbols.h
index 6106f9e..94d3003 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -3,7 +3,7 @@
#ifndef SCM_SYMBOLS_H
#define SCM_SYMBOLS_H
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2010
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008, 2010,
2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -26,8 +26,7 @@
#include "libguile/__scm.h"
-#define scm_is_symbol(x) (!SCM_IMP (x) \
- && (SCM_TYP7 (x) == scm_tc7_symbol))
+#define scm_is_symbol(x) (SCM_HAS_TYP7 (x, scm_tc7_symbol))
#define scm_i_symbol_hash(x) ((unsigned long) SCM_CELL_WORD_2 (x))
#define scm_i_symbol_is_interned(x) \
(!(SCM_CELL_WORD_0 (x) & SCM_I_F_SYMBOL_UNINTERNED))
diff --git a/libguile/tags.h b/libguile/tags.h
index c0ab34c..54b74e0 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?'.
@@ -350,6 +355,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
* since for a SCM variable it is known that tc1==0. */
#define SCM_IMP(x) (6 & SCM_UNPACK (x))
#define SCM_NIMP(x) (!SCM_IMP (x))
+#define SCM_HEAP_OBJECT_P(x) (SCM_NIMP (x))
/* Checking if a SCM variable holds an immediate integer: See numbers.h for
* the definition of the following macros: SCM_I_FIXNUM_BIT,
@@ -385,11 +391,26 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define scm_tc3_tc7_2 7
+/* As we have seen, heap objects have a tag in their three lowest bits.
+ If you have a heap object and want the pointer to the start of the
+ object, perhaps for GC purposes, you need to mask off the low bits,
+ which is what SCM_HEAP_OBJECT_BASE does.
+
+ Note that you can avoid this macro if you know the specific type of
+ the object (pair, struct, or other).
+ */
+#define SCM_HEAP_OBJECT_BASE(x) ((scm_t_bits*)((SCM_UNPACK (x)) & ~7))
+
+
/* Definitions for tc7: */
#define SCM_ITAG7(x) (127 & SCM_UNPACK (x))
#define SCM_TYP7(x) (0x7f & SCM_CELL_TYPE (x))
#define SCM_TYP7S(x) ((0x7f & ~2) & SCM_CELL_TYPE (x))
+#define SCM_HAS_HEAP_TYPE(x, type, tag) \
+ (SCM_NIMP (x) && type (x) == (tag))
+#define SCM_HAS_TYP7(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
+#define SCM_HAS_TYP7S(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP7S, tag))
#define scm_tc7_symbol 5
#define scm_tc7_variable 7
@@ -440,7 +461,8 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
/* Definitions for tc16: */
#define SCM_TYP16(x) (0xffff & SCM_CELL_TYPE (x))
-#define SCM_TYP16_PREDICATE(tag, x) (!SCM_IMP (x) && SCM_TYP16 (x) == (tag))
+#define SCM_HAS_TYP16(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP16, tag))
+#define SCM_TYP16_PREDICATE(tag, x) (SCM_HAS_TYP16 (x, tag))
diff --git a/libguile/validate.h b/libguile/validate.h
index b0e502a..6dea795 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -3,7 +3,7 @@
#ifndef SCM_VALIDATE_H
#define SCM_VALIDATE_H
-/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007, 2009 Free Software
Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007, 2009, 2011 Free
Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -354,7 +354,7 @@
#define SCM_VALIDATE_ARRAY(pos, v) \
do { \
- SCM_ASSERT (!SCM_IMP (v) \
+ SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
&& scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
v, pos, FUNC_NAME); \
} while (0)
diff --git a/libguile/variable.h b/libguile/variable.h
index 20daf85..c024c85 100644
--- a/libguile/variable.h
+++ b/libguile/variable.h
@@ -3,7 +3,7 @@
#ifndef SCM_VARIABLE_H
#define SCM_VARIABLE_H
-/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001, 2006, 2008, 2011 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -30,7 +30,7 @@
/* Variables
*/
-#define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_TYP7(X) == scm_tc7_variable)
+#define SCM_VARIABLEP(X) (SCM_HAS_TYP7 (X, scm_tc7_variable))
#define SCM_VARIABLE_REF(V) SCM_CELL_OBJECT_1 (V)
#define SCM_VARIABLE_SET(V, X) SCM_SET_CELL_OBJECT_1 (V, X)
#define SCM_VARIABLE_LOC(V) (SCM_CELL_OBJECT_LOC ((V), 1))
diff --git a/libguile/vectors.h b/libguile/vectors.h
index fd69a1c..4fe72b0 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -63,8 +63,8 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
/* Internals */
-#define SCM_I_IS_VECTOR(x) (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
-#define SCM_I_IS_NONWEAK_VECTOR(x) (!SCM_IMP(x) &&
(SCM_TYP7(x)==scm_tc7_vector))
+#define SCM_I_IS_VECTOR(x) (SCM_HAS_TYP7S (x, scm_tc7_vector))
+#define SCM_I_IS_NONWEAK_VECTOR(x) (SCM_HAS_TYP7 (x, scm_tc7_vector))
#define SCM_I_VECTOR_ELTS(x) ((const SCM *) SCM_I_VECTOR_WELTS (x))
#define SCM_I_VECTOR_WELTS(x) (SCM_CELL_OBJECT_LOC (x, 1))
#define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 1b4136f..fc4e8bd 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -787,7 +787,7 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (program);
goto vm_call;
}
- else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+ else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
&& SCM_SMOB_APPLICABLE_P (program))
{
SYNC_REGISTER ();
@@ -835,7 +835,7 @@ VM_DEFINE_INSTRUCTION (54, tail_call, "tail-call", 1, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (program);
goto vm_tail_call;
}
- else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+ else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
&& SCM_SMOB_APPLICABLE_P (program))
{
SYNC_REGISTER ();
@@ -1096,7 +1096,7 @@ VM_DEFINE_INSTRUCTION (62, mv_call, "mv-call", 4, -1, 1)
sp[-nargs] = SCM_STRUCT_PROCEDURE (program);
goto vm_mv_call;
}
- else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+ else if (SCM_HAS_TYP7 (program, scm_tc7_smob)
&& SCM_SMOB_APPLICABLE_P (program))
{
SYNC_REGISTER ();
diff --git a/libguile/vm.c b/libguile/vm.c
index 940dd60..9958e11 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/vm.h b/libguile/vm.h
index d354a53..2479ee4 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -55,7 +55,7 @@ struct scm_vm {
SCM_API SCM scm_the_vm_fluid;
-#define SCM_VM_P(x) (SCM_NIMP (x) && SCM_TYP7 (x) == scm_tc7_vm)
+#define SCM_VM_P(x) (SCM_HAS_TYP7 (x, scm_tc7_vm))
#define SCM_VM_DATA(vm) ((struct scm_vm *) SCM_CELL_WORD_1 (vm))
#define SCM_VALIDATE_VM(pos,x) SCM_MAKE_VALIDATE (pos, x, VM_P)
@@ -96,7 +96,7 @@ struct scm_vm_cont {
scm_t_uint32 flags;
};
-#define SCM_VM_CONT_P(OBJ) (SCM_NIMP (OBJ) && SCM_TYP7 (OBJ) ==
scm_tc7_vm_cont)
+#define SCM_VM_CONT_P(OBJ) (SCM_HAS_TYP7 (OBJ, scm_tc7_vm_cont))
#define SCM_VM_CONT_DATA(CONT) ((struct scm_vm_cont *) SCM_CELL_WORD_1 (CONT))
#define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags &
SCM_F_VM_CONT_PARTIAL)
#define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags &
SCM_F_VM_CONT_REWINDABLE)
diff --git a/libguile/weak-set.c b/libguile/weak-set.c
index 7f7717e..626b290 100644
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -136,7 +136,7 @@ typedef struct {
} scm_t_weak_set;
-#define SCM_WEAK_SET_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_weak_set)
+#define SCM_WEAK_SET_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_set))
#define SCM_VALIDATE_WEAK_SET(pos, arg) \
SCM_MAKE_VALIDATE_MSG (pos, arg, WEAK_SET_P, "weak-set")
#define SCM_WEAK_SET(x) ((scm_t_weak_set *) SCM_CELL_WORD_1 (x))
@@ -171,7 +171,7 @@ move_weak_entry (scm_t_weak_entry *from, scm_t_weak_entry
*to)
to->hash = copy.hash;
to->key = copy.key;
- if (copy.key && SCM_NIMP (SCM_PACK (copy.key)))
+ if (copy.key && SCM_HEAP_OBJECT_P (SCM_PACK (copy.key)))
{
GC_unregister_disappearing_link ((GC_PTR) &from->key);
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &to->key,
@@ -358,7 +358,7 @@ resize_set (scm_t_weak_set *set)
new_entries[new_k].hash = copy.hash;
new_entries[new_k].key = copy.key;
- if (SCM_NIMP (SCM_PACK (copy.key)))
+ if (SCM_HEAP_OBJECT_P (SCM_PACK (copy.key)))
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &new_entries[new_k].key,
(GC_PTR) new_entries[new_k].key);
}
@@ -519,9 +519,9 @@ weak_set_add_x (scm_t_weak_set *set, unsigned long hash,
entries[k].hash = hash;
entries[k].key = SCM_UNPACK (obj);
- if (SCM_NIMP (obj))
+ if (SCM_HEAP_OBJECT_P (obj))
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entries[k].key,
- (GC_PTR) SCM2PTR (obj));
+ (GC_PTR) SCM_HEAP_OBJECT_BASE (obj));
return obj;
}
@@ -571,7 +571,7 @@ weak_set_remove_x (scm_t_weak_set *set, unsigned long hash,
entries[k].hash = 0;
entries[k].key = 0;
- if (SCM_NIMP (SCM_PACK (copy.key)))
+ if (SCM_HEAP_OBJECT_P (SCM_PACK (copy.key)))
GC_unregister_disappearing_link ((GC_PTR) &entries[k].key);
if (--set->n_items < set->lower)
@@ -654,7 +654,7 @@ weak_gc_callback (void **weak)
if (!val)
return 0;
- callback (PTR2SCM (val));
+ callback (SCM_PACK_POINTER (val));
return 1;
}
@@ -682,9 +682,9 @@ 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));
+ GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM_HEAP_OBJECT_BASE (obj));
#ifdef HAVE_GC_SET_START_CALLBACK
scm_c_hook_add (&scm_after_gc_c_hook, weak_gc_hook, weak, 0);
@@ -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 160eca2..3ec113a 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -127,17 +127,17 @@ register_disappearing_links (scm_t_weak_entry *entry,
SCM k, SCM v,
scm_t_weak_table_kind kind)
{
- if (SCM_UNPACK (k) && SCM_NIMP (k)
+ if (SCM_UNPACK (k) && SCM_HEAP_OBJECT_P (k)
&& (kind == SCM_WEAK_TABLE_KIND_KEY
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->key,
- (GC_PTR) SCM2PTR (k));
+ (GC_PTR) SCM_HEAP_OBJECT_BASE (k));
- if (SCM_UNPACK (v) && SCM_NIMP (v)
+ if (SCM_UNPACK (v) && SCM_HEAP_OBJECT_P (v)
&& (kind == SCM_WEAK_TABLE_KIND_VALUE
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->value,
- (GC_PTR) SCM2PTR (v));
+ (GC_PTR) SCM_HEAP_OBJECT_BASE (v));
}
static void
@@ -191,7 +191,7 @@ typedef struct {
} scm_t_weak_table;
-#define SCM_WEAK_TABLE_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_weak_table)
+#define SCM_WEAK_TABLE_P(x) (SCM_HAS_TYP7 (x, scm_tc7_weak_table))
#define SCM_VALIDATE_WEAK_TABLE(pos, arg) \
SCM_MAKE_VALIDATE_MSG (pos, arg, WEAK_TABLE_P, "weak-table")
#define SCM_WEAK_TABLE(x) ((scm_t_weak_table *) SCM_CELL_WORD_1 (x))
@@ -302,7 +302,7 @@ mark_weak_key_table (GC_word *addr, struct GC_ms_entry
*mark_stack_ptr,
if (entries[k].hash && entries[k].key)
{
SCM value = SCM_PACK (entries[k].value);
- mark_stack_ptr = GC_MARK_AND_PUSH ((GC_word*) SCM2PTR (value),
+ mark_stack_ptr = GC_MARK_AND_PUSH ((GC_word*) SCM_HEAP_OBJECT_BASE
(value),
mark_stack_ptr, mark_stack_limit,
NULL);
}
@@ -321,7 +321,7 @@ mark_weak_value_table (GC_word *addr, struct GC_ms_entry
*mark_stack_ptr,
if (entries[k].hash && entries[k].value)
{
SCM key = SCM_PACK (entries[k].key);
- mark_stack_ptr = GC_MARK_AND_PUSH ((GC_word*) SCM2PTR (key),
+ mark_stack_ptr = GC_MARK_AND_PUSH ((GC_word*) SCM_HEAP_OBJECT_BASE
(key),
mark_stack_ptr, mark_stack_limit,
NULL);
}
@@ -754,7 +754,7 @@ weak_gc_callback (void **weak)
if (!val)
return 0;
- callback (PTR2SCM (val));
+ callback (SCM_PACK_POINTER (val));
return 1;
}
@@ -782,9 +782,9 @@ 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));
+ GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM_HEAP_OBJECT_BASE (obj));
#ifdef HAVE_GC_TABLE_START_CALLBACK
scm_c_hook_add (&scm_after_gc_c_hook, weak_gc_hook, weak, 0);
@@ -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 a42166b..f829d36 100644
--- a/libguile/weak-vector.c
+++ b/libguile/weak-vector.c
@@ -48,12 +48,12 @@ 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);
- if (SCM_NIMP (fill))
+ if (SCM_HEAP_OBJECT_P (fill))
{
memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM));
for (j = 0; j < len; j++)
@@ -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;
}
@@ -170,14 +170,14 @@ scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
elts = SCM_I_VECTOR_WELTS (wv);
- if (prev && SCM_NIMP (PTR2SCM (prev)))
+ if (prev && SCM_HEAP_OBJECT_P (SCM_PACK_POINTER (prev)))
GC_unregister_disappearing_link ((GC_PTR) &elts[k]);
elts[k] = x;
- if (SCM_NIMP (x))
+ if (SCM_HEAP_OBJECT_P (x))
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &elts[k],
- (GC_PTR) SCM2PTR (x));
+ (GC_PTR) SCM_HEAP_OBJECT_BASE (x));
}
diff --git a/libguile/weak-vector.h b/libguile/weak-vector.h
index 80bb414..1fd7cb5 100644
--- a/libguile/weak-vector.h
+++ b/libguile/weak-vector.h
@@ -28,7 +28,7 @@
/* Weak vectors. */
-#define SCM_I_WVECTP(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_wvect)
+#define SCM_I_WVECTP(x) (SCM_HAS_TYP7 (x, scm_tc7_wvect))
SCM_API SCM scm_make_weak_vector (SCM k, SCM fill);
SCM_API SCM scm_weak_vector (SCM l);
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-39-g8b33752,
Andy Wingo <=