add SCM_HEAP_OBJECT_P

* libguile/tags.h (SCM_HEAP_OBJECT_P): New macro, an alias for
  SCM_NIMP.

* libguile/arrays.c:
* libguile/debug.c:
* libguile/foreign.c:
* libguile/gdbint.c:
* libguile/guardians.c:
* libguile/list.c:
* libguile/modules.c:
* libguile/options.c:
* libguile/smob.c:
* libguile/validate.h:
* libguile/weak-set.c:
* libguile/weak-table.c:
* libguile/weak-vector.c: Use it instead of SCM_NIMP or !SCM_IMP.

diff --git a/libguile/arrays.c b/libguile/arrays.c
index d99081c..cc5c726 100644 (file)
--- 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/debug.c b/libguile/debug.c
index 1a5c197..c6ce99e 100644 (file)
--- 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/foreign.c b/libguile/foreign.c
index 62ebb03..7834118 100644 (file)
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -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;

diff --git a/libguile/gdbint.c b/libguile/gdbint.c
index 77fdbd1..196c498 100644 (file)
--- 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 6aa7a14..42acf1e 100644 (file)
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -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

diff --git a/libguile/list.c b/libguile/list.c
index 221ee79..8297b17 100644 (file)
--- 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/modules.c b/libguile/modules.c
index 971676c..63268fb 100644 (file)
--- 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/options.c b/libguile/options.c
index 0e08314..286d9e1 100644 (file)
--- 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/smob.c b/libguile/smob.c
index 9098dbc..d7f1fb0 100644 (file)
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -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 ()').  */

diff --git a/libguile/tags.h b/libguile/tags.h
index d5fb7e7..d781dfd 100644 (file)
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -355,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,

diff --git a/libguile/validate.h b/libguile/validate.h
index b0e502a..6dea795 100644 (file)
--- 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/weak-set.c b/libguile/weak-set.c
index 4a1c835..6e2e8ab 100644 (file)
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -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,7 +519,7 @@ 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));
 
@@ -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)

diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index 2810e0b..e6e7f2e 100644 (file)
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -127,13 +127,13 @@ 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));
 
-  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,

diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c
index c76ec58..23bc386 100644 (file)
--- a/libguile/weak-vector.c
+++ b/libguile/weak-vector.c
@@ -53,7 +53,7 @@ make_weak_vector (size_t len, SCM fill)
 
   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++)
@@ -170,12 +170,12 @@ 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));
 }