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

* inline.h: include stdio.h

Browse source 
* smob.c (free_print): abort if scm_debug_cell_accesses_p is set
This commit is contained in:
Han-Wen Nienhuys 2002-09-08 11:31:32 +00:00
parent dac04e9fb9
commit 1e71eafb34
6 changed files with 52 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

11
libguile/ChangeLog
View file

@ -1,3 +1,9 @@
2002-09-08 Han-Wen Nienhuys <hanwen@cs.uu.nl>
* inline.h: include stdio.h
* smob.c (free_print): abort if scm_debug_cell_accesses_p is set
2002-09-05 Han-Wen Nienhuys <hanwen@cs.uu.nl>
* gc-segment.c (scm_i_make_initial_segment): check user settings
@ -5,15 +11,14 @@
* gc-malloc.c (scm_gc_init_malloc): check user settings for
sanity.
(scm_gc_register_collectable_memory): prevent overflow of memory
counts.
* gc-freelist.c (scm_init_freelist): check user settings for sanity.
* struct.h: change scm_structs_to_free to scm_i_structs_to_free
* gc-malloc.c (scm_gc_register_collectable_memory): use floats;
these won't ever wrap around with high memory usage.
these won't ever wrap around with high memory usage. Thanks to
Sven Hartrumpf for finding this.
* gc-freelist.c: include <stdio.h>

12
libguile/gc-card.c
View file

@ -327,6 +327,13 @@ scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,
}
#if (SCM_DEBUG_CELL_ACCESSES == 1)
int
scm_gc_marked_p (SCM obj)
{
return SCM_GC_MARK_P(obj);
}
#endif
#if 0
/*
@ -355,11 +362,6 @@ typedef struct scm_t_double_cell
} scm_t_double_cell;
int
scm_gc_marked_p (SCM obj)
{
return SCM_GC_MARK_P(obj);
}
scm_t_cell *
scm_gc_get_card (SCM obj)

2
libguile/gc.c
View file

@ -239,7 +239,7 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
/*
do nothing
*/
fprintf (stderr, "\nWARNING: GUILE was not compiled with SCM_DEBUG_CELL_ACCESSES");
scm_remember_upto_here (flag);
return SCM_UNSPECIFIED;
}

1
libguile/gc.h
View file

@ -251,6 +251,7 @@ typedef unsigned long scm_t_c_bvec_long;
SCM_API int scm_debug_cell_accesses_p;
SCM_API int scm_expensive_debug_cell_accesses_p;
SCM_API int scm_debug_cells_gc_interval ;
void scm_i_expensive_validation_check (SCM cell);
#endif
SCM_API int scm_block_gc;

42
libguile/inline.h
View file

@ -50,6 +50,11 @@
*/
#if (SCM_DEBUG_CELL_ACCESSES == 1)
#include <stdio.h>
#endif
#include "libguile/pairs.h"
#include "libguile/gc.h"
@ -94,20 +99,31 @@ scm_cell (scm_t_bits car, scm_t_bits cdr)
#if (SCM_DEBUG_CELL_ACCESSES == 1)
if (scm_debug_cell_accesses_p)
{
if (SCM_GC_MARK_P (z))
{
fprintf(stderr, "scm_cell tried to allocate a marked cell.\n");
abort();
}
else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell)
{
fprintf(stderr, "cell from freelist is not a free cell.\n");
abort();
}
{
if (SCM_GC_MARK_P (z))
{
fprintf(stderr, "scm_cell tried to allocate a marked cell.\n");
abort();
}
else if (SCM_GC_CELL_TYPE(z) != scm_tc_free_cell)
{
fprintf(stderr, "cell from freelist is not a free cell.\n");
abort();
}
}
/*
Always set mark. Otherwise cells that are alloced before
scm_debug_cell_accesses_p is toggled seem invalid.
*/
SCM_SET_GC_MARK (z);
/*
TODO: figure out if this use of mark bits is valid with
threading. What if another thread is doing GC at this point
... ?
*/
SCM_SET_GC_MARK (z);
}
#endif

7
libguile/smob.c
View file

@ -473,11 +473,16 @@ static int
free_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
char buf[100];
sprintf (buf, "#<freed cell %p; GC missed a reference>",
(void *) SCM_UNPACK (exp));
scm_puts (buf, port);
#if (SCM_DEBUG_CELL_ACCESSES == 1)
if (scm_debug_cell_accesses_p)
abort();
#endif
return 1;
}