* gc.c (scm_done_free): new.

expanded comments about scm_done_malloc.

* gc.h: added prototype for scm_done_free

diff --git a/NEWS b/NEWS
index c72155a..c79e3eb 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -55,6 +55,13 @@ Example:
 
 * Changes to the scm_ interface
 
+** New function: scm_done_free (long size)
+
+This function is the inverse of scm_done_malloc.  Use it to report the
+amount of smob memory you free.  The previous method, which involved
+calling scm_done_malloc with negative argument, was somewhat
+unintuitive (and is still available, of course).
+
 ** New global variable scm_gc_running_p introduced.
 
 Use this variable to find out if garbage collection is being executed.  Up to

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 81993ca..6e92210 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,10 @@
+2000-07-15  Michael Livshin  <mlivshin@bigfoot.com>
+
+       * gc.c (scm_done_free): new.
+       expanded comments about scm_done_malloc.
+
+       * gc.h: added prototype for scm_done_free
+
 2000-07-13  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
        * gc.h (scm_take_stdin):  Removed.

diff --git a/libguile/gc.c b/libguile/gc.c
index 4878e15..ecf4ace 100644 (file)
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -107,7 +107,7 @@ scm_assert_cell_valid (SCM cell)
     {
       scm_debug_cell_accesses_p = 0;  /* disable to avoid recursion */
 
-      if (!scm_cellp (cell)) 
+      if (!scm_cellp (cell))
        {
          fprintf (stderr, "scm_assert_cell_valid: Not a cell object: %lx\n", SCM_UNPACK (cell));
          abort ();
@@ -1034,7 +1034,7 @@ gc_mark_nimp:
         * to a heap cell.  If it is a struct, the cell word #0 of ptr is a
         * pointer to a struct vtable data region. The fact that these are
         * accessed in the same way restricts the possibilites to change the
-        * data layout of structs or heap cells. 
+        * data layout of structs or heap cells.
         */
        scm_bits_t word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_cons_gloc;
        scm_bits_t * vtable_data = (scm_bits_t *) word0; /* access as struct */
@@ -1369,7 +1369,7 @@ scm_cellp (SCM value)
       }
     }
 
-    if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr) 
+    if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
        && SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr)
        && (scm_heap_table[i].span == 1 || SCM_DOUBLE_CELLP (value))) {
       return 1;
@@ -1475,7 +1475,7 @@ scm_gc_sweep ()
                      vtable_data [scm_vtable_index_vcell] = 0;
                    goto cmrkcontinue;
                  }
-               else 
+               else
                  {
                    if (vtable_data [scm_vtable_index_vcell] == 0
                        || vtable_data [scm_vtable_index_vcell] == 1)
@@ -1733,12 +1733,12 @@ scm_gc_sweep ()
 
 /* {Front end to malloc}
  *
- * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc
+ * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc,
+ * scm_done_free
  *
  * These functions provide services comperable to malloc, realloc, and
  * free.  They are for allocating malloced parts of scheme objects.
- * The primary purpose of the front end is to impose calls to gc.
- */
+ * The primary purpose of the front end is to impose calls to gc.  */
 
 
 /* scm_must_malloc
@@ -1864,7 +1864,13 @@ scm_must_free (void *obj)
  * reason).  When a new object of this smob is created you call
  * scm_done_malloc with the size of the object.  When your smob free
  * function is called, be sure to include this size in the return
- * value. */
+ * value.
+ *
+ * If you can't actually free the memory in the smob free function,
+ * for whatever reason (like reference counting), you still can (and
+ * should) report the amount of memory freed when you actually free it.
+ * Do it by calling scm_done_malloc with the _negated_ size.  Clever,
+ * eh?  Or even better, call scm_done_free. */
 
 void
 scm_done_malloc (long size)
@@ -1884,6 +1890,12 @@ scm_done_malloc (long size)
     }
 }
 
+void
+scm_done_free (long size)
+{
+  scm_mallocated -= size;
+}
+
 
 \f
 
@@ -2045,7 +2057,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
   SCM_CELLPTR ptr;
   long len;
 
-  if (scm_gc_heap_lock) 
+  if (scm_gc_heap_lock)
     {
       /* Critical code sections (such as the garbage collector) aren't
        * supposed to add heap segments.
@@ -2054,7 +2066,7 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
       abort ();
     }
 
-  if (scm_n_heap_segs == heap_segment_table_size) 
+  if (scm_n_heap_segs == heap_segment_table_size)
     {
       /* We have to expand the heap segment table to have room for the new
        * segment.  Do not yet increment scm_n_heap_segs -- that is done by
@@ -2254,15 +2266,15 @@ SCM
 scm_protect_object (SCM obj)
 {
   SCM handle;
-  
+
   /* This critical section barrier will be replaced by a mutex. */
   SCM_REDEFER_INTS;
-  
+
   handle = scm_hashq_create_handle_x (scm_protects, obj, SCM_MAKINUM (0));
   SCM_SETCDR (handle, SCM_MAKINUM (SCM_INUM (SCM_CDR (handle)) + 1));
-  
+
   SCM_REALLOW_INTS;
-  
+
   return obj;
 }
 
@@ -2275,12 +2287,12 @@ SCM
 scm_unprotect_object (SCM obj)
 {
   SCM handle;
-  
+
   /* This critical section barrier will be replaced by a mutex. */
   SCM_REDEFER_INTS;
-  
+
   handle = scm_hashq_get_handle (scm_protects, obj);
-  
+
   if (SCM_IMP (handle))
     {
       fprintf (stderr, "scm_unprotect_object called on unprotected object\n");

diff --git a/libguile/gc.h b/libguile/gc.h
index c400162..9a647e8 100644 (file)
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -284,6 +284,7 @@ extern void * scm_must_realloc (void *where,
                                scm_sizet olen, scm_sizet len,
                                const char *what);
 extern void scm_done_malloc (long size);
+extern void scm_done_free (long size);
 extern void scm_must_free (void *obj);
 extern void scm_remember (SCM * ptr);
 extern SCM scm_return_first (SCM elt, ...);