mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

* Use appropriate error signalling functions.

Browse source
This commit is contained in:
Dirk Herrmann 2000-06-29 13:31:33 +00:00
parent fc3d77788a
commit acf4331fa5
2 changed files with 27 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/ChangeLog
View file

@ -1,3 +1,9 @@
2000-06-29 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gc.c (scm_gc_mark, scm_gc_sweep, scm_must_malloc,
scm_must_realloc, scm_must_free, alloc_some_heap): Use the
appropriate error signalling function.
2000-06-29 Dirk Herrmann <D.Herrmann@tu-bs.de> 2000-06-29 Dirk Herrmann <D.Herrmann@tu-bs.de>
* root.h (scm_first_type): Removed. * root.h (scm_first_type): Removed.

32
libguile/gc.c
View file

@ -887,6 +887,7 @@ scm_igc (const char *what)
*/ */
void void
scm_gc_mark (SCM p) scm_gc_mark (SCM p)
#define FUNC_NAME "scm_gc_mark"
{ {
register long i; register long i;
register SCM ptr; register SCM ptr;
@ -899,7 +900,7 @@ gc_mark_loop:
gc_mark_nimp: gc_mark_nimp:
if (SCM_NCELLP (ptr)) if (SCM_NCELLP (ptr))
scm_wta (ptr, "rogue pointer in heap", NULL); SCM_MISC_ERROR ("rogue pointer in heap", SCM_EOL);
switch (SCM_TYP7 (ptr)) switch (SCM_TYP7 (ptr))
{ {
@ -1178,9 +1179,11 @@ gc_mark_nimp:
} }
break; break;
default: default:
def:scm_wta (ptr, "unknown type in ", "gc_mark"); def:
SCM_MISC_ERROR ("unknown type", SCM_EOL);
} }
} }
#undef FUNC_NAME
/* Mark a Region Conservatively /* Mark a Region Conservatively
@ -1321,6 +1324,7 @@ gc_sweep_freelist_finish (scm_freelist_t *freelist)
void void
scm_gc_sweep () scm_gc_sweep ()
#define FUNC_NAME "scm_gc_sweep"
{ {
register SCM_CELLPTR ptr; register SCM_CELLPTR ptr;
register SCM nfreelist; register SCM nfreelist;
@ -1546,7 +1550,8 @@ scm_gc_sweep ()
} }
break; break;
default: default:
sweeperr:scm_wta (scmptr, "unknown type in ", "gc_sweep"); sweeperr:
SCM_MISC_ERROR ("unknown type", SCM_EOL);
} }
#if 0 #if 0
if (SCM_CAR (scmptr) == (SCM) scm_tc_free_cell) if (SCM_CAR (scmptr) == (SCM) scm_tc_free_cell)
@ -1623,6 +1628,7 @@ scm_gc_sweep ()
scm_mallocated -= m; scm_mallocated -= m;
scm_gc_malloc_collected = m; scm_gc_malloc_collected = m;
} }
#undef FUNC_NAME
@ -1687,8 +1693,7 @@ scm_must_malloc (scm_sizet size, const char *what)
return ptr; return ptr;
} }
scm_wta (SCM_MAKINUM (size), (char *) SCM_NALLOC, what); scm_memory_error (what);
return 0; /* never reached */
} }
@ -1736,12 +1741,13 @@ scm_must_realloc (void *where,
return ptr; return ptr;
} }
scm_wta (SCM_MAKINUM (size), (char *) SCM_NALLOC, what); scm_memory_error (what);
return 0; /* never reached */
} }
void void
scm_must_free (void *obj) scm_must_free (void *obj)
#define FUNC_NAME "scm_must_free"
{ {
#ifdef GUILE_DEBUG_MALLOC #ifdef GUILE_DEBUG_MALLOC
scm_malloc_unregister (obj); scm_malloc_unregister (obj);
@ -1749,8 +1755,10 @@ scm_must_free (void *obj)
if (obj) if (obj)
free (obj); free (obj);
else else
scm_wta (SCM_INUM0, "already free", ""); SCM_MISC_ERROR ("freeing NULL pointer", SCM_EOL);
} }
#undef FUNC_NAME
/* Announce that there has been some malloc done that will be freed /* 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 * during gc. A typical use is for a smob that uses some malloced
@ -1933,6 +1941,7 @@ round_to_cluster_size (scm_freelist_t *freelist, scm_sizet len)
static void static void
alloc_some_heap (scm_freelist_t *freelist) alloc_some_heap (scm_freelist_t *freelist)
#define FUNC_NAME "alloc_some_heap"
{ {
scm_heap_seg_data_t * tmptable; scm_heap_seg_data_t * tmptable;
SCM_CELLPTR ptr; SCM_CELLPTR ptr;
@ -1942,7 +1951,7 @@ alloc_some_heap (scm_freelist_t *freelist)
* aren't supposed to add heap segments. * aren't supposed to add heap segments.
*/ */
if (scm_gc_heap_lock) if (scm_gc_heap_lock)
scm_wta (SCM_UNDEFINED, "need larger initial", "heap"); SCM_MISC_ERROR ("can not grow heap while locked", SCM_EOL);
/* Expand the heap tables to have room for the new segment. /* Expand the heap tables to have room for the new segment.
* Do not yet increment scm_n_heap_segs -- that is done by init_heap_seg * Do not yet increment scm_n_heap_segs -- that is done by init_heap_seg
@ -1953,7 +1962,7 @@ alloc_some_heap (scm_freelist_t *freelist)
SCM_SYSCALL (tmptable = ((scm_heap_seg_data_t *) SCM_SYSCALL (tmptable = ((scm_heap_seg_data_t *)
realloc ((char *)scm_heap_table, len))); realloc ((char *)scm_heap_table, len)));
if (!tmptable) if (!tmptable)
scm_wta (SCM_UNDEFINED, "could not grow", "hplims"); SCM_MISC_ERROR ("could not grow heap segment table", SCM_EOL);
else else
scm_heap_table = tmptable; scm_heap_table = tmptable;
@ -2016,8 +2025,9 @@ alloc_some_heap (scm_freelist_t *freelist)
} }
} }
scm_wta (SCM_UNDEFINED, "could not grow", "heap"); SCM_MISC_ERROR ("could not grow heap", SCM_EOL);
} }
#undef FUNC_NAME
SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0, SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,