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

* gc.c (scm_gc_sweep): Free the SCM_VELTS of a scm_tc7_contin only

Browse source 
when they are non-NULL.
(scm_gc_mark): Likewise, mark only when non-NULL.

* gc.c (scm_done_malloc): New function.
gc.h (scm_done_malloc): New prototype.
This commit is contained in:
Marius Vollmer 1997-10-02 14:45:09 +00:00
parent 5fccacb91b
commit c68296f8fd
1 changed files with 42 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

43
libguile/gc.c
View file

@ -441,6 +441,8 @@ scm_igc (what)
SCM_THREAD_CRITICAL_SECTION_START; SCM_THREAD_CRITICAL_SECTION_START;
#endif #endif
// fprintf (stderr, "gc: %s\n", what);
scm_gc_start (what); scm_gc_start (what);
if (!scm_stack_base || scm_block_gc) if (!scm_stack_base || scm_block_gc)
{ {
@ -689,10 +691,12 @@ gc_mark_nimp:
if SCM_GC8MARKP if SCM_GC8MARKP
(ptr) break; (ptr) break;
SCM_SETGC8MARK (ptr); SCM_SETGC8MARK (ptr);
if (SCM_VELTS (ptr))
scm_mark_locations (SCM_VELTS (ptr), scm_mark_locations (SCM_VELTS (ptr),
(scm_sizet) (scm_sizet)
(SCM_LENGTH (ptr) + (SCM_LENGTH (ptr) +
(sizeof (SCM_STACKITEM) + -1 + sizeof (scm_contregs)) / (sizeof (SCM_STACKITEM) + -1 +
sizeof (scm_contregs)) /
sizeof (SCM_STACKITEM))); sizeof (SCM_STACKITEM)));
break; break;
case scm_tc7_bvect: case scm_tc7_bvect:
@ -1191,6 +1195,7 @@ scm_gc_sweep ()
if SCM_GC8MARKP (scmptr) if SCM_GC8MARKP (scmptr)
goto c8mrkcontinue; goto c8mrkcontinue;
m += SCM_LENGTH (scmptr) * sizeof (SCM_STACKITEM) + sizeof (scm_contregs); m += SCM_LENGTH (scmptr) * sizeof (SCM_STACKITEM) + sizeof (scm_contregs);
if (SCM_VELTS (scmptr))
goto freechars; goto freechars;
case scm_tc7_ssymbol: case scm_tc7_ssymbol:
if SCM_GC8MARKP(scmptr) if SCM_GC8MARKP(scmptr)
@ -1374,7 +1379,7 @@ scm_gc_sweep ()
/* {Front end to malloc} /* {Front end to malloc}
* *
* scm_must_malloc, scm_must_realloc, scm_must_free * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc
* *
* These functions provide services comperable to malloc, realloc, and * These functions provide services comperable to malloc, realloc, and
* free. They are for allocating malloced parts of scheme objects. * free. They are for allocating malloced parts of scheme objects.
@ -1482,10 +1487,37 @@ scm_must_free (obj)
else else
scm_wta (SCM_INUM0, "already free", ""); scm_wta (SCM_INUM0, "already free", "");
} }
/* Announce that there has been some malloc done that will be freed
* during gc. A typical use is for a smob that uses some malloced
* memory but can not get it from scm_must_malloc (for whatever
* 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. */
void
scm_done_malloc (size)
long size;
{
scm_mallocated += size;
if (scm_mallocated > scm_mtrigger)
{
scm_igc ("foreign mallocs");
if (scm_mallocated > scm_mtrigger - SCM_MTRIGGER_HYSTERESIS)
{
if (scm_mallocated > scm_mtrigger)
scm_mtrigger = scm_mallocated + scm_mallocated / 2;
else
scm_mtrigger += scm_mtrigger / 2;
}
}
}
/* {Heap Segments} /* {Heap Segments}
* *
* Each heap segment is an array of objects of a particular size. * Each heap segment is an array of objects of a particular size.
@ -1493,8 +1525,7 @@ scm_must_free (obj)
* A table of segment records is kept that records the upper and * A table of segment records is kept that records the upper and
* lower extents of the segment; this is used during the conservative * lower extents of the segment; this is used during the conservative
* phase of gc to identify probably gc roots (because they point * phase of gc to identify probably gc roots (because they point
* into valid segments at reasonable offsets). * into valid segments at reasonable offsets). */
*/
/* scm_expmem /* scm_expmem
* is true if the first segment was smaller than INIT_HEAP_SEG. * is true if the first segment was smaller than INIT_HEAP_SEG.