Some SCM/scm_bits_t type strictness fixes.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 01c72a4..41244aa 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,23 @@
+2000-04-07  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+       * __scm.h (SCM_WTA_DISPATCH_[012n]):  To test whether a SCM value
+       contains a raw zero value it has to be unpacked.
+
+       * debug.c (with_traps_inner, scm_with_traps):  Passing SCM values
+       via void * requires unpacking / packing.
+
+       * stacks.h (SCM_STACKP):  Remove unnecessary SCM_NIMP test and use
+       SCM_EQ_P to compare SCM values.
+
+       * stacks.h (SCM_FRAME_VOID_P, SCM_FRAME_REAL_P, SCM_FRAME_PROC_P,
+       SCM_FRAME_EVAL_ARGS_P, SCM_FRAME_OVERFLOW_P):  Remove unnecessary
+       call to SCM_UNPACK.
+
+       * tags.h (SCM_NECONSP):  Define in terms of SCM_ECONSP
+
+       * tags.h (SCM_ECONSP):  Clarify the test for glocs.  This is still
+       quite ugly.
+
 2000-04-05  Michael Livshin  <mlivshin@bigfoot.com>
 
        * async.[ch]: unexpose low-level async access macros (thanks to

diff --git a/libguile/__scm.h b/libguile/__scm.h
index 9c530ca..7ca2241 100644 (file)
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -429,10 +429,15 @@ do { \
  * SCM_WTA_DISPATCH
  */
 
+/* Dirk:FIXME:: In all of the SCM_WTA_DISPATCH_* macros it is assumed that
+ * 'gf' is zero if uninitialized.  It would be cleaner if some valid SCM value
+ * like SCM_BOOL_F or SCM_UNDEFINED was chosen.
+ */
+
 extern SCM scm_call_generic_0 (SCM gf);
 
 #define SCM_WTA_DISPATCH_0(gf, arg, pos, subr) \
-  return ((gf) \
+  return (SCM_UNPACK (gf) \
           ? scm_call_generic_0 ((gf)) \
           : scm_wta ((arg), (char *) (pos), (subr)))
 #define SCM_GASSERT0(cond, gf, arg, pos, subr) \
@@ -441,7 +446,7 @@ extern SCM scm_call_generic_0 (SCM gf);
 extern SCM scm_call_generic_1 (SCM gf, SCM a1);
 
 #define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \
-  return ((gf) \
+  return (SCM_UNPACK (gf) \
           ? scm_call_generic_1 ((gf), (a1)) \
           : scm_wta ((a1), (char *) (pos), (subr)))
 #define SCM_GASSERT1(cond, gf, a1, pos, subr) \
@@ -450,7 +455,7 @@ extern SCM scm_call_generic_1 (SCM gf, SCM a1);
 extern SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
 
 #define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \
-  return ((gf) \
+  return (SCM_UNPACK (gf) \
           ? scm_call_generic_2 ((gf), (a1), (a2)) \
           : scm_wta ((pos) == SCM_ARG1 ? (a1) : (a2), (char *) (pos), (subr)))
 #define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
@@ -459,7 +464,7 @@ extern SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
 extern SCM scm_apply_generic (SCM gf, SCM args);
 
 #define SCM_WTA_DISPATCH_n(gf, args, pos, subr) \
-  return ((gf) \
+  return (SCM_UNPACK (gf) \
           ? scm_apply_generic ((gf), (args)) \
           : scm_wta (scm_list_ref ((args), SCM_MAKINUM ((pos) - 1)), \
                     (char *) (pos), \

diff --git a/libguile/debug.c b/libguile/debug.c
index 4f021df..237c018 100644 (file)
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -117,7 +117,7 @@ with_traps_after (void *data)
 static SCM
 with_traps_inner (void *data)
 {
-  SCM thunk = (SCM) data;
+  SCM thunk = SCM_PACK (data);
   return scm_apply (thunk, SCM_EOL, SCM_EOL);
 }
 
@@ -131,7 +131,7 @@ SCM_DEFINE (scm_with_traps, "with-traps", 1, 0, 0,
   return scm_internal_dynamic_wind (with_traps_before,
                                    with_traps_inner,
                                    with_traps_after,
-                                   (void *) thunk,
+                                   (void *) SCM_UNPACK (thunk),
                                    &trap_flag);
 }
 #undef FUNC_NAME

diff --git a/libguile/stacks.h b/libguile/stacks.h
index 1862477..2a5ea82 100644 (file)
--- a/libguile/stacks.h
+++ b/libguile/stacks.h
@@ -76,8 +76,7 @@ typedef struct scm_stack {
 
 extern SCM scm_stack_type;
 
-#define SCM_STACKP(obj) (SCM_NIMP(obj) && \
-                         SCM_STRUCTP (obj) && SCM_STRUCT_VTABLE (obj) == scm_stack_type)
+#define SCM_STACKP(obj) (SCM_STRUCTP (obj) && SCM_EQ_P (SCM_STRUCT_VTABLE (obj), scm_stack_type))
 #define SCM_STACK_LENGTH(stack) (SCM_STACK (stack) -> length)
 
 #define SCM_FRAMEP(obj) (SCM_CONSP (obj) \
@@ -108,11 +107,11 @@ extern SCM scm_stack_type;
 #define SCM_FRAMEF_EVAL_ARGS   (1L << 5)
 #define SCM_FRAMEF_OVERFLOW    (1L << 6)
 
-#define SCM_FRAME_VOID_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_VOID)
-#define SCM_FRAME_REAL_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_REAL)
-#define SCM_FRAME_PROC_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_PROC)
-#define SCM_FRAME_EVAL_ARGS_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_EVAL_ARGS)
-#define SCM_FRAME_OVERFLOW_P(frame) (SCM_UNPACK (SCM_FRAME_FLAGS (frame)) & SCM_FRAMEF_OVERFLOW)
+#define SCM_FRAME_VOID_P(f)       (SCM_FRAME_FLAGS (f) & SCM_FRAMEF_VOID)
+#define SCM_FRAME_REAL_P(f)       (SCM_FRAME_FLAGS (f) & SCM_FRAMEF_REAL)
+#define SCM_FRAME_PROC_P(f)       (SCM_FRAME_FLAGS (f) & SCM_FRAMEF_PROC)
+#define SCM_FRAME_EVAL_ARGS_P(f)  (SCM_FRAME_FLAGS (f) & SCM_FRAMEF_EVAL_ARGS)
+#define SCM_FRAME_OVERFLOW_P(f)   (SCM_FRAME_FLAGS (f) & SCM_FRAMEF_OVERFLOW)
 
 \f
 

diff --git a/libguile/tags.h b/libguile/tags.h
index 74317ca..e443ef2 100644 (file)
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -304,14 +304,8 @@ typedef long scm_bits_t;
   (SCM_NIMP (x) \
    && (SCM_SLOPPY_CONSP (x) \
        || (SCM_TYP3 (x) == 1 \
-          && (SCM_CDR ((SCM) SCM_STRUCT_VTABLE_DATA (x)) \
-              != (SCM) 0))))
-#define SCM_NECONSP(x) \
-  (SCM_IMP (x) \
-   || (SCM_SLOPPY_NCONSP (x) \
-       && (SCM_TYP3 (x) != 1 \
-          || (SCM_CDR ((SCM) SCM_STRUCT_VTABLE_DATA (x)) \
-              == (SCM) 0))))
+          && (SCM_STRUCT_VTABLE_DATA (x)[scm_vtable_index_vcell] != 0))))
+#define SCM_NECONSP(x) (!SCM_ECONSP (x))
 
 \f