mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-04 19:20:27 +02:00
Code Activity

* gc.h (SCM_GC_CELL_TYPE): SCM_GC_CELL_TYPE uses SCM_GC_CELL_OBJECT.

Browse source 
* goops.h (SCM_NUMBER_OF_SLOTS): don't SCM_UNPACK the result.

* backtrace.c ("display_backtrace_body"): SCM_PACK before SCM_EQ_P
(display_frame): idem.
(display_backtrace_file_and_line): idem.

* tags.h (SCM_UNPACK): stricter typechecking on SCM_UNPACK
arguments.
This commit is contained in:
Han-Wen Nienhuys 2004-03-28 13:55:03 +00:00
parent 88a7ae1f68
commit 702551e6cc
7 changed files with 35 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/ChangeLog
View file

@ -1,3 +1,16 @@
2004-03-28 Han-Wen Nienhuys <hanwen@xs4all.nl>
* gc.h (SCM_GC_CELL_TYPE): SCM_GC_CELL_TYPE uses SCM_GC_CELL_OBJECT.
* goops.h (SCM_NUMBER_OF_SLOTS): don't SCM_UNPACK the result.
* backtrace.c ("display_backtrace_body"): SCM_PACK before SCM_EQ_P
(display_frame): idem.
(display_backtrace_file_and_line): idem.
* tags.h (SCM_UNPACK): stricter typechecking on SCM_UNPACK
arguments.
2004-03-26 Kevin Ryde <user42@zip.com.au>
* filesys.c (scm_getcwd, scm_readlink): Avoid memory leak on errors.

6
libguile/backtrace.c
View file

@ -521,7 +521,7 @@ display_backtrace_file_and_line (SCM frame, SCM port, scm_print_state *pstate)
display_backtrace_get_file_line (frame, &file, &line);
if (SCM_EQ_P (SCM_SHOW_FILE_NAME, sym_base))
if (SCM_EQ_P (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base))
{
if (SCM_FALSEP (file))
{
@ -572,7 +572,7 @@ display_frame (SCM frame, int nfield, int indentation, SCM sport, SCM port, scm_
}
/* display file name and line number */
if (!SCM_FALSEP (SCM_SHOW_FILE_NAME))
if (!SCM_FALSEP (SCM_PACK (SCM_SHOW_FILE_NAME)))
display_backtrace_file_and_line (frame, port, pstate);
/* Check size of frame number. */
@ -722,7 +722,7 @@ display_backtrace_body (struct display_backtrace_args *a)
last_file = SCM_UNDEFINED;
for (i = 0; i < n; ++i)
{
if (!SCM_EQ_P (SCM_SHOW_FILE_NAME, sym_base))
if (!SCM_EQ_P (SCM_PACK (SCM_SHOW_FILE_NAME), sym_base))
display_backtrace_file (frame, &last_file, a->port, pstate);
display_frame (frame, nfield, indentation, sport, a->port, pstate);

2
libguile/debug.c
View file

@ -87,7 +87,7 @@ with_traps_after (void *data)
static SCM
with_traps_inner (void *data)
{
SCM thunk = SCM_PACK (data);
SCM thunk = SCM_PACK ((scm_t_bits) data);
return scm_call_0 (thunk);
}

2
libguile/gc-mark.c
View file

@ -166,7 +166,7 @@ scm_gc_mark_dependencies (SCM p)
{
register long i;
register SCM ptr;
scm_t_bits cell_type;
SCM cell_type;
ptr = p;
scm_mark_dependencies_again:

2
libguile/gc.h
View file

@ -151,7 +151,7 @@ typedef unsigned long scm_t_c_bvec_long;
(((scm_t_bits *) SCM2PTR (x)) [n] = (scm_t_bits) (v))
#define SCM_GC_SET_CELL_OBJECT(x, n, v) \
(((scm_t_bits *) SCM2PTR (x)) [n] = SCM_UNPACK (v))
#define SCM_GC_CELL_TYPE(x) SCM_GC_CELL_WORD (x, 0)
#define SCM_GC_CELL_TYPE(x) SCM_GC_CELL_OBJECT (x, 0) /* ugh - only used once. */
/* Except for the garbage collector, no part of guile should ever run over a

3
libguile/goops.h
View file

@ -99,8 +99,7 @@ typedef struct scm_t_method {
#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
#define SCM_ACCESSORS_OF(x) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x)[scm_si_getters_n_setters]))
#define SCM_NUMBER_OF_SLOTS(x) \
(SCM_UNPACK (SCM_STRUCT_DATA (x)[scm_struct_i_n_words]) \
- scm_struct_n_extra_words)
((SCM_STRUCT_DATA (x)[scm_struct_i_n_words]) - scm_struct_n_extra_words)
#define SCM_CLASSP(x) \
(SCM_STRUCTP (x) && SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_METACLASS)

17
libguile/tags.h
View file

@ -106,8 +106,21 @@ typedef unsigned long scm_t_bits;
* type checking while still resulting in very efficient code.
*/
typedef struct scm_unused_struct * SCM;
# define SCM_UNPACK(x) ((scm_t_bits) (x))
/*
The 0?: constructions makes sure that the code is never executed,
and that there is no performance hit. However, the alternative is
compiled, and does generate a warning when used with the wrong
pointer type.
*/
# define SCM_UNPACK(x) ((scm_t_bits) (0? (*(SCM*)0=(x)): x))
/*
There is no typechecking on SCM_PACK, since all kinds of types
(unsigned long, void*) go in SCM_PACK
*/
# define SCM_PACK(x) ((SCM) (x))
#else
/* This should be used as a fall back solution for machines on which casting
* to a pointer may lead to loss of bit information, e. g. in the three least
@ -115,7 +128,7 @@ typedef unsigned long scm_t_bits;
*/
typedef scm_t_bits SCM;
# define SCM_UNPACK(x) (x)
# define SCM_PACK(x) ((scm_t_bits) (x))
# define SCM_PACK(x) ((SCM) (x))
#endif