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

libguile/gc.c

@@ -332,14 +332,12 @@ 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;
 
@@ -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 =
@@ -393,9 +396,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
 		SCM_UNDEFINED);
   SCM_CRITICAL_SECTION_END;
 
-  free (bounds);
+/*   free (bounds); */
   return answer;
-#endif
 }
 #undef FUNC_NAME
 

libguile/ports.c

@@ -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,
+  tmp = (char *) scm_gc_realloc ((char *) scm_ptobs,
+				 scm_numptob * sizeof (scm_t_ptob_descriptor),
 				 (1 + scm_numptob)
-				       * sizeof (scm_t_ptob_descriptor)));
+				 * 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_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_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,
+      /* 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));
+					     * scm_i_port_table_room * 2),
+				   "port-table");
       scm_i_port_table = (scm_t_port **) newt;
       scm_i_port_table_room *= 2;
     }
@@ -1156,6 +1159,7 @@ 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");
 }