mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-07 08:40:21 +02:00
Code Activity

* stacks.c: Avoid compiler warning re: unitialized var.

Browse source 
* scmconfig.h.in: Added DEBUG_FREELIST

* pairs.h: Fix macro that was not do-while(0) sandwiched.

* gc.h, gc.c: Added scm_gc_set_debug_check_freelist_x,
scm_map_free_list
This commit is contained in:
Greg J. Badros 1999-09-27 23:30:36 +00:00
parent 52b3923a9d
commit 25748c78cf
5 changed files with 27 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/gc.c
View file

@ -290,14 +290,28 @@ scm_check_freelist ()
} }
static int scm_debug_check_freelist = 0; static int scm_debug_check_freelist = 0;
SCM_PROC (s_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0, scm_gc_set_debug_check_freelist_x);
SCM
scm_gc_set_debug_check_freelist_x (SCM flag)
{
SCM_ASSERT(SCM_BOOL_T == flag || SCM_BOOL_F == flag,
flag, 1, s_gc_set_debug_check_freelist_x);
scm_debug_check_freelist = (SCM_BOOL_T==flag)? 1: 0;
return SCM_UNSPECIFIED;
}
SCM SCM
scm_debug_newcell (void) scm_debug_newcell (void)
{ {
SCM new; SCM new;
scm_newcell_count++; scm_newcell_count++;
if (scm_debug_check_freelist) if (scm_debug_check_freelist) {
scm_check_freelist (); scm_check_freelist ();
scm_gc();
}
/* The rest of this is supposed to be identical to the SCM_NEWCELL /* The rest of this is supposed to be identical to the SCM_NEWCELL
macro. */ macro. */

2
libguile/gc.h
View file

@ -76,7 +76,9 @@ extern long scm_mallocated;
extern unsigned long scm_mtrigger; extern unsigned long scm_mtrigger;
#ifdef DEBUG_FREELIST #ifdef DEBUG_FREELIST
extern SCM scm_map_free_list (void);
extern SCM scm_debug_newcell (void); extern SCM scm_debug_newcell (void);
extern SCM scm_gc_set_debug_check_freelist_x (SCM flag);
#endif #endif

6
libguile/pairs.h
View file

@ -145,10 +145,10 @@ typedef SCM huge *SCMPTR;
#ifdef DEBUG_FREELIST #ifdef DEBUG_FREELIST
#define SCM_NEWCELL(_into) (_into = scm_debug_newcell ()) #define SCM_NEWCELL(_into) do { _into = scm_debug_newcell (); } while (0)
#else #else
#define SCM_NEWCELL(_into) \ #define SCM_NEWCELL(_into) \
{ \ do { \
if (SCM_IMP(scm_freelist)) \ if (SCM_IMP(scm_freelist)) \
_into = scm_gc_for_newcell();\ _into = scm_gc_for_newcell();\
else \ else \
@ -157,7 +157,7 @@ typedef SCM huge *SCMPTR;
scm_freelist = SCM_CDR(scm_freelist);\ scm_freelist = SCM_CDR(scm_freelist);\
++scm_cells_allocated; \ ++scm_cells_allocated; \
} \ } \
} } while(0)
#endif #endif

3
libguile/scmconfig.h.in
View file

@ -98,6 +98,9 @@
#undef DEBUG_EXTENSIONS #undef DEBUG_EXTENSIONS
#undef READER_EXTENSIONS #undef READER_EXTENSIONS
/* Define this if you want to debug the free list (helps w/ GC bugs) */
#undef DEBUG_FREELIST
/* Define this if your system defines S_ISLNK in sys/stat.h */ /* Define this if your system defines S_ISLNK in sys/stat.h */
#undef HAVE_S_ISLNK #undef HAVE_S_ISLNK

8
libguile/stacks.c
View file

@ -440,7 +440,7 @@ scm_make_stack (args)
SCM args; SCM args;
{ {
int n, maxp, size; int n, maxp, size;
scm_debug_frame *dframe; scm_debug_frame *dframe = scm_last_debug_frame;
scm_info_frame *iframe; scm_info_frame *iframe;
long offset = 0; long offset = 0;
SCM stack, id; SCM stack, id;
@ -455,9 +455,9 @@ scm_make_stack (args)
/* Extract a pointer to the innermost frame of whatever object /* Extract a pointer to the innermost frame of whatever object
scm_make_stack was given. */ scm_make_stack was given. */
if (obj == SCM_BOOL_T) /* just use dframe == scm_last_debug_frame
dframe = scm_last_debug_frame; (from initialization of dframe, above) if obj is #t */
else if (obj != SCM_BOOL_T)
{ {
SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, s_make_stack); SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, s_make_stack);
if (SCM_DEBUGOBJP (obj)) if (SCM_DEBUGOBJP (obj))