mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
First `working'' Guile! Crashes in
flush-all-ports' (relates to SCM_I_PORT_TABLE).
* libguile/gc.c (scm_gc_stats): Fixed so that it returns a relevant result instead of just `SCM_EOL'. * libguile/ports.c: Include `assert.h'. Don't include `malloc.h'. (scm_make_port_type): Use `scm_gc_realloc ()' instead of `realloc ()'. (scm_new_port_table_entry): Likewise. (scm_flush): Added an assertion on the port number. (scm_ports_prehistory): Use `scm_gc_malloc ()' instead of `scm_malloc ()'. git-archimport-id: lcourtes@laas.fr--2005-libre/guile-core--boehm-gc--1.9--patch-3
This commit is contained in:
parent
c812243ba1
commit
fca4388748
2 changed files with 32 additions and 22 deletions
|
@ -332,17 +332,15 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
|
|||
abort();
|
||||
#endif
|
||||
|
||||
return SCM_EOL; /* FIXME */
|
||||
#if 0
|
||||
/* Below, we cons to produce the resulting list. We want a snapshot of
|
||||
* the heap situation before consing.
|
||||
*/
|
||||
local_scm_mtrigger = scm_mtrigger;
|
||||
local_scm_mallocated = scm_mallocated;
|
||||
local_scm_heap_size = 0; /* SCM_HEAP_SIZE; */ /* FIXME */
|
||||
local_scm_heap_size = GC_get_heap_size ();
|
||||
|
||||
local_scm_cells_allocated = scm_cells_allocated;
|
||||
|
||||
|
||||
local_scm_gc_time_taken = scm_gc_time_taken;
|
||||
local_scm_gc_mark_time_taken = scm_gc_mark_time_taken;
|
||||
local_scm_gc_times = scm_gc_times;
|
||||
|
@ -356,12 +354,17 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
|
|||
+(double) scm_gc_cells_swept
|
||||
-(double) scm_gc_cells_collected;
|
||||
|
||||
#if 0
|
||||
for (i = table_size; i--;)
|
||||
{
|
||||
heap_segs = scm_cons (scm_cons (scm_from_ulong (bounds[2*i]),
|
||||
scm_from_ulong (bounds[2*i+1])),
|
||||
heap_segs);
|
||||
}
|
||||
#else
|
||||
heap_segs = scm_list (SCM_INUM0); /* FIXME */
|
||||
#endif
|
||||
|
||||
/* njrev: can any of these scm_cons's or scm_list_n signal a memory
|
||||
error? If so we need a frame here. */
|
||||
answer =
|
||||
|
@ -392,10 +395,9 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
|
|||
scm_cons (sym_heap_segments, heap_segs),
|
||||
SCM_UNDEFINED);
|
||||
SCM_CRITICAL_SECTION_END;
|
||||
|
||||
free (bounds);
|
||||
|
||||
/* free (bounds); */
|
||||
return answer;
|
||||
#endif
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
@ -28,6 +28,8 @@
|
|||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#include <assert.h>
|
||||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/async.h"
|
||||
#include "libguile/eval.h"
|
||||
|
@ -50,10 +52,6 @@
|
|||
#include <string.h>
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_MALLOC_H
|
||||
#include <malloc.h>
|
||||
#endif
|
||||
|
||||
#ifdef HAVE_IO_H
|
||||
#include <io.h>
|
||||
#endif
|
||||
|
@ -126,9 +124,11 @@ scm_make_port_type (char *name,
|
|||
if (255 <= scm_numptob)
|
||||
goto ptoberr;
|
||||
SCM_CRITICAL_SECTION_START;
|
||||
SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_ptobs,
|
||||
(1 + scm_numptob)
|
||||
* sizeof (scm_t_ptob_descriptor)));
|
||||
tmp = (char *) scm_gc_realloc ((char *) scm_ptobs,
|
||||
scm_numptob * sizeof (scm_t_ptob_descriptor),
|
||||
(1 + scm_numptob)
|
||||
* sizeof (scm_t_ptob_descriptor),
|
||||
"port-type");
|
||||
if (tmp)
|
||||
{
|
||||
scm_ptobs = (scm_t_ptob_descriptor *) tmp;
|
||||
|
@ -475,10 +475,10 @@ scm_i_dynwind_current_load_port (SCM port)
|
|||
|
||||
/* The port table --- an array of pointers to ports. */
|
||||
|
||||
scm_t_port **scm_i_port_table;
|
||||
scm_t_port **scm_i_port_table = NULL;
|
||||
|
||||
long scm_i_port_table_size = 0; /* Number of ports in scm_i_port_table. */
|
||||
long scm_i_port_table_room = 20; /* Size of the array. */
|
||||
long scm_i_port_table_size = 0; /* Number of ports in SCM_I_PORT_TABLE. */
|
||||
long scm_i_port_table_room = 20; /* Actual size of the array. */
|
||||
|
||||
scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
|
||||
|
||||
|
@ -499,9 +499,12 @@ scm_new_port_table_entry (scm_t_bits tag)
|
|||
{
|
||||
/* initial malloc is in gc.c. this doesn't use scm_gc_malloc etc.,
|
||||
since it can never be freed during gc. */
|
||||
void *newt = scm_realloc ((char *) scm_i_port_table,
|
||||
(size_t) (sizeof (scm_t_port *)
|
||||
* scm_i_port_table_room * 2));
|
||||
/* XXX (Ludo): Why not do it actually? */
|
||||
void *newt = scm_gc_realloc ((char *) scm_i_port_table,
|
||||
scm_i_port_table_room * sizeof (scm_t_port *),
|
||||
(size_t) (sizeof (scm_t_port *)
|
||||
* scm_i_port_table_room * 2),
|
||||
"port-table");
|
||||
scm_i_port_table = (scm_t_port **) newt;
|
||||
scm_i_port_table_room *= 2;
|
||||
}
|
||||
|
@ -1152,10 +1155,11 @@ scm_c_write (SCM port, const void *ptr, size_t size)
|
|||
pt->rw_active = SCM_PORT_WRITE;
|
||||
}
|
||||
|
||||
void
|
||||
void
|
||||
scm_flush (SCM port)
|
||||
{
|
||||
long i = SCM_PTOBNUM (port);
|
||||
assert ((i >= 0) && (i < scm_i_port_table_size));
|
||||
(scm_ptobs[i].flush) (port);
|
||||
}
|
||||
|
||||
|
@ -1610,7 +1614,11 @@ void
|
|||
scm_ports_prehistory ()
|
||||
{
|
||||
scm_numptob = 0;
|
||||
scm_ptobs = (scm_t_ptob_descriptor *) scm_malloc (sizeof (scm_t_ptob_descriptor));
|
||||
scm_ptobs = NULL;
|
||||
|
||||
scm_i_port_table = scm_gc_malloc (scm_i_port_table_room
|
||||
* sizeof (scm_t_port *),
|
||||
"port-table");
|
||||
}
|
||||
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue