diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-04-07 10:41:39 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-04-07 10:41:39 +0000 |
commit | 451e591cdd87cc352a84e6bb28db9e0fca41b3fe (patch) | |
tree | 6d998ff68503a20cedc2b47070594bad264910aa | |
parent | e94e3f21d68575cded1b03fb07a66ae622b321e6 (diff) | |
download | guile-451e591cdd87cc352a84e6bb28db9e0fca41b3fe.tar.gz |
Some SCM/scm_bits_t type strictness fixes.
-rw-r--r-- | libguile/ChangeLog | 20 | ||||
-rw-r--r-- | libguile/__scm.h | 13 | ||||
-rw-r--r-- | libguile/debug.c | 4 | ||||
-rw-r--r-- | libguile/stacks.h | 13 | ||||
-rw-r--r-- | libguile/tags.h | 10 |
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)) |