summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-04-07 10:41:39 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-04-07 10:41:39 +0000
commit451e591cdd87cc352a84e6bb28db9e0fca41b3fe (patch)
tree6d998ff68503a20cedc2b47070594bad264910aa
parente94e3f21d68575cded1b03fb07a66ae622b321e6 (diff)
downloadguile-451e591cdd87cc352a84e6bb28db9e0fca41b3fe.tar.gz
Some SCM/scm_bits_t type strictness fixes.
-rw-r--r--libguile/ChangeLog20
-rw-r--r--libguile/__scm.h13
-rw-r--r--libguile/debug.c4
-rw-r--r--libguile/stacks.h13
-rw-r--r--libguile/tags.h10
5 files changed, 39 insertions, 21 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 01c72a445..41244aadf 100644
--- 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 9c530cae8..7ca2241e0 100644
--- 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 4f021dff4..237c018fc 100644
--- 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 186247785..2a5ea828d 100644
--- 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)
diff --git a/libguile/tags.h b/libguile/tags.h
index 74317caaf..e443ef2db 100644
--- 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))