Re: Calling Scheme from C and Garbage Collection

[Greg Harvey <Greg.Harvey@thezone.net>]

Mikael Djurfeldt <mdj@nada.kth.se> writes:

> Radey Shouman <Radey_Shouman@splashtech.com> writes:
> 
> > One could just have a flag used by the gc, to tell it not to link all
> > the free cells into the free list.  This way, SCM_NEWCELL need only
> > check for a null free list, as before.  In the degenerate case, the
> > list would always be null.
> 
> I think this is a good idea.
> 
> It would be great if you could implement.  :-)
> 
> You only need to add a new option in scm_eval_opts (or, perhaps
> better, add a new options interface for the garbage collector).
> 

Since I've already done most of this with the gc, here's a patch (I
haven't tested this, though; the current state of a lot of my gc stuff
is a bit, um, unorganized ;')

*Changelog*

1998-12-05  Greg Harvey  <Greg.Harvey@thezone.net>

	* gc.c (scm_gc_sweep, init_heap_seg): set the cdrs of free cells to SCM_EOL if
	SCM_GC_COLLECT_ON_ALL_ALLOCS is true.

	* gc.h (SCM_GC_COLLECT_ON_ALL_ALLOCS): added define for options
	and extern decl for scm_gc_options.

	* gc.c (scm_gc_options): added options interface for gc.

Index: gc.c
===================================================================
RCS file: /egcs/carton/cvsfiles/guile/guile-core/libguile/gc.c,v
retrieving revision 1.38
diff -c -c -r1.38 gc.c
*** gc.c	1998/10/19 21:35:30	1.38
--- gc.c	1998/12/05 04:22:27
***************
*** 69,74 ****
--- 69,90 ----
  #endif
  
  
+ /* {Options} */
+ 
+ scm_option scm_gc_opts[] = {
+   { SCM_OPTION_BOOLEAN, "Collect each allocation", 0, 
+     "Do a gc after each cell allocation."}};
+ 
+ SCM_PROC(s_gc_options, "gc-options-interface", 0, 1, 0, scm_gc_options);
+ 
+ SCM
+ scm_gc_options(SCM setting)
+ {
+   SCM ans = scm_options(setting, scm_gc_opts, SCM_N_GC_OPTIONS, s_gc_options);
+   return ans;
+ }
+ 
+ 
  /* {heap tuning parameters}
   * 
   * These are parameters for controlling memory allocation.  The heap
***************
*** 1285,1291 ****
  	     conservative collector might trace it as some other type
  	     of object.  */
  	  SCM_SETCAR (scmptr, (SCM) scm_tc_free_cell);
! 	  SCM_SETCDR (scmptr, nfreelist);
  	  nfreelist = scmptr;
  
  	  continue;
--- 1301,1310 ----
  	     conservative collector might trace it as some other type
  	     of object.  */
  	  SCM_SETCAR (scmptr, (SCM) scm_tc_free_cell);
! 	  if(SCM_GC_COLLECT_ON_ALL_ALLOCS)
! 	    SCM_SETCDR(scmptr, SCM_EOL);
! 	  else
! 	    SCM_SETCDR (scmptr, nfreelist);
  	  nfreelist = scmptr;
  
  	  continue;
***************
*** 1634,1640 ****
        scmptr = PTR2SCM (ptr);
  #endif
        SCM_SETCAR (scmptr, (SCM) scm_tc_free_cell);
!       SCM_SETCDR (scmptr, PTR2SCM (ptr + ncells));
        ptr += ncells;
      }
  
--- 1653,1662 ----
        scmptr = PTR2SCM (ptr);
  #endif
        SCM_SETCAR (scmptr, (SCM) scm_tc_free_cell);
!       if(SCM_GC_COLLECT_ON_ALL_ALLOCS) 
! 	SCM_SETCDR(scmptr, SCM_EOL);
!       else 
! 	SCM_SETCDR (scmptr, PTR2SCM (ptr + ncells));
        ptr += ncells;
      }
  
***************
*** 1643,1649 ****
    /* Patch up the last freelist pointer in the segment
     * to join it to the input freelist.
     */
!   SCM_SETCDR (PTR2SCM (ptr), *freelistp);
    *freelistp = PTR2SCM (CELL_UP (seg_org));
  
    scm_heap_size += (ncells * n_new_objects);
--- 1665,1672 ----
    /* Patch up the last freelist pointer in the segment
     * to join it to the input freelist.
     */
!   if(!SCM_GC_COLLECT_ON_ALL_ALLOCS)
!     SCM_SETCDR (PTR2SCM (ptr), *freelistp);
    *freelistp = PTR2SCM (CELL_UP (seg_org));
  
    scm_heap_size += (ncells * n_new_objects);
***************
*** 1905,1908 ****
--- 1928,1932 ----
  scm_init_gc ()
  {
  #include "gc.x"
+     scm_init_opts (scm_gc_options, scm_gc_opts, SCM_N_GC_OPTIONS);
  }
Index: gc.h
===================================================================
RCS file: /egcs/carton/cvsfiles/guile/guile-core/libguile/gc.h,v
retrieving revision 1.15
diff -c -c -r1.15 gc.h
*** gc.h	1998/10/24 20:56:42	1.15
--- gc.h	1998/12/05 04:22:30
***************
*** 46,51 ****
--- 46,59 ----
  
  #include "libguile/__scm.h"
  
+ /*OPTIONS defines*/
+ 
+ extern scm_option scm_gc_opts[];
+ 
+ #define SCM_GC_COLLECT_ON_ALL_ALLOCS scm_gc_opts[0].val
+ #define SCM_GC_N_OPTIONS 1
+ 
+ extern SCM scm_gc_options(SCM setting);
  
  #define SCM_FREEP(x) (SCM_CAR(x)==scm_tc_free_cell)
  #define SCM_NFREEP(x) (!SCM_FREEP(x))

-- 
Greg