mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Some SCM/scm_bits_t type strictness fixes.

Browse source
This commit is contained in:
Dirk Herrmann 2000-04-07 10:41:39 +00:00
parent e94e3f21d6
commit 451e591cdd
5 changed files with 39 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/ChangeLog
View file

@ -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

13
libguile/__scm.h
View file

@ -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), \

4
libguile/debug.c
View file

@ -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

13
libguile/stacks.h
View file

@ -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)

10
libguile/tags.h
View file

@ -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))