* gc.h, gc.c (scm_gc_sweep): Issue deprecation warning when

non-zero is returned from a port or smob free function.
(scm_malloc, scm_realloc, scm_strndup, scm_strdup,
scm_gc_register_collectable_memory,
scm_gc_unregister_collectable_memory, scm_gc_malloc,
scm_gc_realloc, scm_gc_free, scm_gc_strndup, scm_gc_strdup): New.

* backtrace.c, continuations.c, convert.i.c, coop-threads.c,
debug-malloc.c, dynl.c, environments.c, environments.h,
extensions.c, filesys.c, fports.c, gc.c, gc.h, gh_data.c, goops.c,
guardians.c, hooks.c, init.c, keywords.c, load.c, numbers.c,
ports.c, posix.c, procs.c, rdelim.c, regex-posix.c, root.c,
smob.c, stime.c, strings.c, struct.c, struct.h, symbols.c, unif.c,
vectors.c, weaks.c: Use scm_gc_malloc/scm_malloc and
scm_gc_free/free instead of scm_must_malloc and scm_must_free, as
appropriate.  Return zero from smob and port free functions.

* debug-malloc.c (scm_malloc_reregister): Handle "old == NULL".

* fports.c (scm_setvbuf): Reset read buffer to saved values when
it is pointing to the putback buffer.

libguile/backtrace.c

@@ -312,10 +312,9 @@ SCM_DEFINE (scm_set_print_params_x, "set-print-params!", 1, 0, 0,
 		params,
 		SCM_ARG2,
 		s_scm_set_print_params_x);
-  new_params = scm_must_malloc (n * sizeof (print_params_t),
+  new_params = scm_malloc (n * sizeof (print_params_t));
-				FUNC_NAME);
   if (print_params != default_print_params)
-    scm_must_free (print_params);
+    free (print_params);
   print_params = new_params;
   for (i = 0; i < n; ++i)
     {

libguile/continuations.c

@@ -94,11 +94,11 @@ continuation_free (SCM obj)
     + extra_items * sizeof (SCM_STACKITEM);
 
 #ifdef __ia64__
-  bytes_free += continuation->backing_store_size;
+  scm_gc_free (continuation->backing_store, continuation->backing_store_size,
-  scm_must_free (continuation->backing_store);
+	       "continuation backing store");
 #endif /* __ia64__ */ 
-  scm_must_free (continuation);
+  scm_gc_free (continuation, bytes_free, "continuation");
-  return bytes_free;
+  return 0;
 }
 
 static int
@@ -146,9 +146,9 @@ scm_make_continuation (int *first)
   SCM_ENTER_A_SECTION;
   SCM_FLUSH_REGISTER_WINDOWS;
   stack_size = scm_stack_size (rootcont->base);
-  continuation = scm_must_malloc (sizeof (scm_t_contregs)
+  continuation = scm_gc_malloc (sizeof (scm_t_contregs)
 				+ (stack_size - 1) * sizeof (SCM_STACKITEM),
-				  FUNC_NAME);
+				"continuation");
   continuation->num_stack_items = stack_size;
   continuation->dynenv = scm_dynwinds;
   continuation->throw_value = SCM_EOL;
@@ -174,7 +174,8 @@ scm_make_continuation (int *first)
         (unsigned long) __libc_ia64_register_backing_store_base;
       continuation->backing_store = NULL;
       continuation->backing_store = 
-        scm_must_malloc (continuation->backing_store_size, FUNC_NAME);
+        scm_gc_malloc (continuation->backing_store_size,
+		       "continuation backing store");
       memcpy (continuation->backing_store, 
               (void *) __libc_ia64_register_backing_store_base, 
               continuation->backing_store_size);

libguile/convert.i.c

@@ -152,8 +152,7 @@ CTYPES2UVECT (const CTYPE *data, long n)
 
   SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), 
 		    n > 0 && n <= SCM_UVECTOR_MAX_LENGTH);
-  if ((v = (char *) SCM_MUST_MALLOC_TYPE_NUM (CTYPE, n)) == NULL)
+  v = scm_gc_malloc (sizeof (CTYPE) * n, "vector");
-    return SCM_UNDEFINED;
   memcpy (v, data, n * sizeof (CTYPE));
   return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v);
 }
@@ -168,8 +167,7 @@ CTYPES2UVECT2 (const unsigned CTYPE *data, long n)
 
   SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), 
 		    n > 0 && n <= SCM_UVECTOR_MAX_LENGTH);
-  if ((v = (char *) SCM_MUST_MALLOC_TYPE_NUM (unsigned CTYPE, n)) == NULL)
+  v = scm_gc_malloc (sizeof (unsigned CTYPE) * n, "vector");
-    return SCM_UNDEFINED;
   memcpy (v, data, n * sizeof (unsigned CTYPE));
   return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE2), (scm_t_bits) v);
 }

libguile/coop-threads.c

@@ -324,7 +324,7 @@ c_launch_thread (void *p)
 		     data,
 		     (SCM_STACKITEM *) &thread);
   scm_thread_count--;
-  scm_must_free ((char *) data);
+  free ((char *) data);
 }
 
 SCM
@@ -334,8 +334,7 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data,
   SCM thread;
   coop_t *t;
   SCM root, old_winds;
-  c_launch_data *data = (c_launch_data *) scm_must_malloc (sizeof (*data),
+  c_launch_data *data = (c_launch_data *) scm_malloc (sizeof (*data));
-							   "scm_spawn_thread");
   
   /* Unwind wind chain. */
   old_winds = scm_dynwinds;
@@ -414,11 +413,8 @@ scm_single_thread_p (void)
 SCM
 scm_make_mutex (void)
 {
-  SCM m;
+  SCM m = scm_make_smob (scm_tc16_mutex);
-  coop_m *data = (coop_m *) scm_must_malloc (sizeof (coop_m), "mutex");
+  coop_mutex_init (SCM_MUTEX_DATA (m));
-
-  SCM_NEWSMOB (m, scm_tc16_mutex, (scm_t_bits) data);
-  coop_mutex_init (data);
   return m;
 }
 
@@ -446,9 +442,7 @@ scm_unlock_mutex (SCM m)
 SCM
 scm_make_condition_variable (void)
 {
-  SCM c;
+  SCM c = scm_make_smob (scm_tc16_condvar);
-  coop_c *data = (coop_c *) scm_must_malloc (sizeof (coop_c), "condvar");
-  SCM_NEWSMOB (c, scm_tc16_condvar, (scm_t_bits) data);
   coop_condition_variable_init (SCM_CONDVAR_DATA (c));
   return c;
 }

libguile/debug-malloc.c

@@ -183,7 +183,7 @@ scm_malloc_unregister (void *obj)
   if (type == 0)
     {
       fprintf (stderr,
-	       "scm_must_free called on object not allocated with scm_must_malloc\n");
+	       "scm_gc_free called on object not allocated with scm_gc_malloc\n");
       abort ();
     }
   type->data = (void *) ((int) type->data - 1);
@@ -194,12 +194,18 @@ void
 scm_malloc_reregister (void *old, void *new, const char *newwhat)
 {
   hash_entry_t *object, *type;
+
+  if (old == NULL)
+    scm_malloc_register (new, newwhat);
+  else
+    {
       GET_CREATE_HASH_ENTRY (object, object, old, l1);
       type = (hash_entry_t *) object->data;
       if (type == 0)
 	{
 	  fprintf (stderr,
-	       "scm_must_realloc called on object not allocated with scm_must_malloc\n");
+		   "scm_gc_realloc called on object not allocated "
+		   "with scm_gc_malloc\n");
 	  abort ();
 	}
       if (strcmp ((char *) type->key, newwhat) != 0)
@@ -207,7 +213,7 @@ scm_malloc_reregister (void *old, void *new, const char *newwhat)
 	  if (strcmp (newwhat, "vector-set-length!") != 0)
 	    {
 	      fprintf (stderr,
-		   "scm_must_realloc called with arg %s, was %s\n",
+		       "scm_gc_realloc called with arg %s, was %s\n",
 		       newwhat,
 		       (char *) type->key);
 	      abort ();
@@ -219,12 +225,13 @@ scm_malloc_reregister (void *old, void *new, const char *newwhat)
 	  CREATE_HASH_ENTRY (object, new, type, l2);
 	}
     }
+}
 
 SCM_DEFINE (scm_malloc_stats, "malloc-stats", 0, 0, 0,
 	    (),
 	    "Return an alist ((@var{what} . @var{n}) ...) describing number\n"
 	    "of malloced objects.\n"
-	    "@var{what} is the second argument to @code{scm_must_malloc},\n"
+	    "@var{what} is the second argument to @code{scm_gc_malloc},\n"
 	    "@var{n} is the number of objects of that type currently\n"
 	    "allocated.")
 #define FUNC_NAME s_scm_malloc_stats

libguile/dynl.c

@@ -89,7 +89,8 @@ maybe_drag_in_eprintf ()
    (Dirk: IMO strings.c is not the right place.) */
 
 static char **
-scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
+scm_make_argv_from_stringlist (SCM args, int *argcp, const char *subr, 
+			       int argn)
 {
   char **argv;
   int argc;
@@ -97,7 +98,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
 
   argc = scm_ilength (args);
   SCM_ASSERT (argc >= 0, args, argn, subr);
-  argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr);
+  argv = (char **) scm_malloc ((argc + 1) * sizeof (char *));
   for (i = 0; !SCM_NULL_OR_NIL_P (args); args = SCM_CDR (args), ++i) {
     SCM arg = SCM_CAR (args);
     size_t len;
@@ -107,7 +108,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
     SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr);
     len = SCM_STRING_LENGTH (arg);
     src = SCM_STRING_CHARS (arg);
-    dst = (char *) scm_must_malloc (len + 1, subr);
+    dst = (char *) scm_malloc (len + 1);
     memcpy (dst, src, len);
     dst[len] = 0;
     argv[i] = dst;
@@ -120,7 +121,7 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
 }
 
 static void
-scm_must_free_argv(char **argv)
+scm_free_argv (char **argv)
 {
   char **av = argv;
   while (*av)
@@ -398,7 +399,7 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
   SCM_DEFER_INTS;
   argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME, SCM_ARG3);
   result = (*fptr) (argc, argv);
-  scm_must_free_argv (argv);
+  scm_free_argv (argv);
   SCM_ALLOW_INTS;
 
   return SCM_MAKINUM (0L + result);

libguile/environments.c

@@ -476,7 +476,8 @@ environment_mark (SCM env)
 static size_t
 environment_free (SCM env)
 {
-  return (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env);
+  (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env);
+  return 0;
 }
 
 
@@ -984,13 +985,12 @@ leaf_environment_mark (SCM env)
 }
 
 
-static size_t
+static void
 leaf_environment_free (SCM env)
 {
   core_environments_finalize (env);
-
+  scm_gc_free (LEAF_ENVIRONMENT (env), sizeof (struct leaf_environment),
-  free (LEAF_ENVIRONMENT (env));
+	       "leaf environment");
-  return sizeof (struct leaf_environment);
 }
 
 
@@ -1034,7 +1034,7 @@ SCM_DEFINE (scm_make_leaf_environment, "make-leaf-environment", 0, 0, 0,
 #define FUNC_NAME s_scm_make_leaf_environment
 {
   size_t size = sizeof (struct leaf_environment);
-  struct leaf_environment *body = scm_must_malloc (size, FUNC_NAME);
+  struct leaf_environment *body = scm_gc_malloc (size, "leaf environment");
   SCM env;
 
   core_environments_preinit (&body->base);
@@ -1345,13 +1345,12 @@ eval_environment_mark (SCM env)
 }
 
 
-static size_t
+static void
 eval_environment_free (SCM env)
 {
   core_environments_finalize (env);
-
+  scm_gc_free (EVAL_ENVIRONMENT (env), sizeof (struct eval_environment),
-  free (EVAL_ENVIRONMENT (env));
+	       "eval environment");
-  return sizeof (struct eval_environment);
 }
 
 
@@ -1428,7 +1427,7 @@ SCM_DEFINE (scm_make_eval_environment, "make-eval-environment", 2, 0, 0,
   SCM_ASSERT (SCM_ENVIRONMENT_P (local), local, SCM_ARG1, FUNC_NAME);
   SCM_ASSERT (SCM_ENVIRONMENT_P (imported), imported, SCM_ARG2, FUNC_NAME);
 
-  body = scm_must_malloc (sizeof (struct eval_environment), FUNC_NAME);
+  body = scm_gc_malloc (sizeof (struct eval_environment), "eval environment");
 
   core_environments_preinit (&body->base);
   body->obarray = SCM_BOOL_F;
@@ -1764,13 +1763,12 @@ import_environment_mark (SCM env)
 }
 
 
-static size_t
+static void
 import_environment_free (SCM env)
 {
   core_environments_finalize (env);
-
+  scm_gc_free (IMPORT_ENVIRONMENT (env), sizeof (struct import_environment),
-  free (IMPORT_ENVIRONMENT (env));
+	       "import environment");
-  return sizeof (struct import_environment);
 }
 
 
@@ -1844,7 +1842,7 @@ SCM_DEFINE (scm_make_import_environment, "make-import-environment", 2, 0, 0,
 #define FUNC_NAME s_scm_make_import_environment
 {
   size_t size = sizeof (struct import_environment);
-  struct import_environment *body = scm_must_malloc (size, FUNC_NAME);
+  struct import_environment *body = scm_gc_malloc (size, "import environment");
   SCM env;
 
   core_environments_preinit (&body->base);
@@ -2070,13 +2068,12 @@ export_environment_mark (SCM env)
 }
 
 
-static size_t
+static void
 export_environment_free (SCM env)
 {
   core_environments_finalize (env);
-
+  scm_gc_free (EXPORT_ENVIRONMENT (env), sizeof (struct export_environment),
-  free (EXPORT_ENVIRONMENT (env));
+	       "export environment");
-  return sizeof (struct export_environment);
 }
 
 
@@ -2171,7 +2168,7 @@ SCM_DEFINE (scm_make_export_environment, "make-export-environment", 2, 0, 0,
   SCM_ASSERT (SCM_ENVIRONMENT_P (private), private, SCM_ARG1, FUNC_NAME);
 
   size = sizeof (struct export_environment);
-  body = scm_must_malloc (size, FUNC_NAME);
+  body = scm_gc_malloc (size, "export environment");
 
   core_environments_preinit (&body->base);
   body->private = SCM_BOOL_F;

libguile/environments.h

@@ -76,7 +76,7 @@ struct scm_environment_funcs {
   void (*unobserve) (SCM self, SCM token);
 
   SCM (*mark) (SCM self);
-  size_t (*free) (SCM self);
+  void (*free) (SCM self);
   int (*print) (SCM self, SCM port, scm_print_state *pstate);
 };
 

libguile/extensions.c

@@ -74,13 +74,12 @@ void
 scm_c_register_extension (const char *lib, const char *init,
 			  void (*func) (void *), void *data)
 {
-  extension_t *ext = scm_must_malloc (sizeof(extension_t),
+  extension_t *ext = scm_malloc (sizeof(extension_t));
-					   "scm_register_extension");
   if (lib)
-    ext->lib = scm_must_strdup (lib);
+    ext->lib = scm_strdup (lib);
   else
     ext->lib = NULL;
-  ext->init = scm_must_strdup (init);
+  ext->init = scm_strdup (init);
   ext->func = func;
   ext->data = data;
 

libguile/filesys.c

@@ -942,17 +942,17 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
   char *wd;
   SCM result;
 
-  wd = scm_must_malloc (size, FUNC_NAME);
+  wd = scm_malloc (size);
   while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
     {
-      scm_must_free (wd);
+      free (wd);
       size *= 2;
-      wd = scm_must_malloc (size, FUNC_NAME);
+      wd = scm_malloc (size);
     }
   if (rv == 0)
     SCM_SYSERROR;
   result = scm_mem2string (wd, strlen (wd));
-  scm_must_free (wd);
+  free (wd);
   return result;
 }
 #undef FUNC_NAME
@@ -1367,17 +1367,17 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
   char *buf;
   SCM result;
   SCM_VALIDATE_STRING (1, path);
-  buf = scm_must_malloc (size, FUNC_NAME);
+  buf = scm_malloc (size);
   while ((rv = readlink (SCM_STRING_CHARS (path), buf, size)) == size)
     {
-      scm_must_free (buf);
+      free (buf);
       size *= 2;
-      buf = scm_must_malloc (size, FUNC_NAME);
+      buf = scm_malloc (size);
     }
   if (rv == -1)
     SCM_SYSERROR;
   result = scm_mem2string (buf, rv);
-  scm_must_free (buf);
+  free (buf);
   return result;
 }
 #undef FUNC_NAME

libguile/fports.c

@@ -111,7 +111,7 @@ scm_fport_buffer_add (SCM port, long read_size, int write_size)
 
   if (SCM_INPUT_PORT_P (port) && read_size > 0)
     {
-      pt->read_buf = scm_must_malloc (read_size, FUNC_NAME);
+      pt->read_buf = scm_gc_malloc (read_size, "port buffer");
       pt->read_pos = pt->read_end = pt->read_buf;
       pt->read_buf_size = read_size;
     }
@@ -123,7 +123,7 @@ scm_fport_buffer_add (SCM port, long read_size, int write_size)
 
   if (SCM_OUTPUT_PORT_P (port) && write_size > 0)
     {
-      pt->write_buf = scm_must_malloc (write_size, FUNC_NAME);
+      pt->write_buf = scm_gc_malloc (write_size, "port buffer");
       pt->write_pos = pt->write_buf;
       pt->write_buf_size = write_size;
     }
@@ -192,11 +192,18 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 
   pt = SCM_PTAB_ENTRY (port);
 
-  /* silently discards buffered chars.  */
+  /* silently discards buffered and put-back chars.  */
+  if (pt->read_buf == pt->putback_buf)
+    {
+      pt->read_buf = pt->saved_read_buf;
+      pt->read_pos = pt->saved_read_pos;
+      pt->read_end = pt->saved_read_end;
+      pt->read_buf_size = pt->saved_read_buf_size;
+    }
   if (pt->read_buf != &pt->shortbuf)
-    scm_must_free (pt->read_buf);
+    scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
   if (pt->write_buf != &pt->shortbuf)
-    scm_must_free (pt->write_buf);
+    scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
 
   scm_fport_buffer_add (port, csize, csize);
   return SCM_UNSPECIFIED;
@@ -436,8 +443,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
 
   {
     scm_t_fport *fp
-      = (scm_t_fport *) scm_must_malloc (sizeof (scm_t_fport),
+      = (scm_t_fport *) scm_gc_malloc (sizeof (scm_t_fport), "file port");
-					      FUNC_NAME);
 
     fp->fdes = fdes;
     pt->rw_random = SCM_FDES_RANDOM_P (fdes);
@@ -820,10 +826,10 @@ fport_close (SCM port)
   if (pt->read_buf == pt->putback_buf)
     pt->read_buf = pt->saved_read_buf;
   if (pt->read_buf != &pt->shortbuf)
-    scm_must_free (pt->read_buf);
+    scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
   if (pt->write_buf != &pt->shortbuf)
-    scm_must_free (pt->write_buf);
+    scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
-  scm_must_free ((char *) fp);
+  scm_gc_free (fp, sizeof (*fp), "file port");
   return rv;
 }
 

libguile/gc.c

@@ -241,8 +241,8 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0,
  * INIT_MALLOC_LIMIT is the initial amount of malloc usage which will
  * trigger a GC.
  *
- * SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must be
+ * SCM_MTRIGGER_HYSTERESIS is the amount of malloc storage that must
- * reclaimed by a GC triggered by must_malloc. If less than this is
+ * be reclaimed by a GC triggered by a malloc. If less than this is
  * reclaimed, the trigger threshold is raised. [I don't know what a
  * good value is. I arbitrarily chose 1/10 of the INIT_MALLOC_LIMIT to
  * work around a oscillation that caused almost constant GC.]
@@ -1635,15 +1635,17 @@ scm_gc_sweep ()
 		unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
 		if (length > 0)
 		  {
-		    m += length * sizeof (scm_t_bits);
+		    scm_gc_free (SCM_VECTOR_BASE (scmptr),
-		    scm_must_free (SCM_VECTOR_BASE (scmptr));
+				 length * sizeof (scm_t_bits),
+				 "vector");
 		  }
 		break;
 	      }
 #ifdef CCLO
 	    case scm_tc7_cclo:
-	      m += (SCM_CCLO_LENGTH (scmptr) * sizeof (SCM));
+	      scm_gc_free (SCM_CCLO_BASE (scmptr), 
-	      scm_must_free (SCM_CCLO_BASE (scmptr));
+			   SCM_CCLO_LENGTH (scmptr) * sizeof (SCM),
+			   "compiled closure");
 	      break;
 #endif
 #ifdef HAVE_ARRAYS
@@ -1652,8 +1654,10 @@ scm_gc_sweep ()
 		unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
 		if (length > 0)
 		  {
-		    m += sizeof (long) * ((length + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
+		    scm_gc_free (SCM_BITVECTOR_BASE (scmptr),
-		    scm_must_free (SCM_BITVECTOR_BASE (scmptr));
+				 (sizeof (long)
+				  * ((length+SCM_LONG_BIT-1) / SCM_LONG_BIT)),
+				 "vector");
 		  }
 	      }
 	      break;
@@ -1667,17 +1671,19 @@ scm_gc_sweep ()
 	    case scm_tc7_fvect:
 	    case scm_tc7_dvect:
 	    case scm_tc7_cvect:
-	      m += SCM_UVECTOR_LENGTH (scmptr) * scm_uniform_element_size (scmptr);
+	      scm_gc_free (SCM_UVECTOR_BASE (scmptr), 
-	      scm_must_free (SCM_UVECTOR_BASE (scmptr));
+			   (SCM_UVECTOR_LENGTH (scmptr)
+			    * scm_uniform_element_size (scmptr)),
+			   "vector");
 	      break;
 #endif
 	    case scm_tc7_string:
-	      m += SCM_STRING_LENGTH (scmptr) + 1;
+	      scm_gc_free (SCM_STRING_CHARS (scmptr), 
-	      scm_must_free (SCM_STRING_CHARS (scmptr));
+			   SCM_STRING_LENGTH (scmptr) + 1, "string");
 	      break;
 	    case scm_tc7_symbol:
-	      m += SCM_SYMBOL_LENGTH (scmptr) + 1;
+	      scm_gc_free (SCM_SYMBOL_CHARS (scmptr), 
-	      scm_must_free (SCM_SYMBOL_CHARS (scmptr));
+			   SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol");
 	      break;
             case scm_tc7_variable:
               break;
@@ -1688,6 +1694,7 @@ scm_gc_sweep ()
 	      if SCM_OPENP (scmptr)
 		{
 		  int k = SCM_PTOBNUM (scmptr);
+		  size_t mm;
 #if (SCM_DEBUG_CELL_ACCESSES == 1) || (defined (GUILE_DEBUG_FREELIST))
 		  if (!(k < scm_numptob))
 		    SCM_MISC_ERROR ("undefined port type", SCM_EOL);
@@ -1698,7 +1705,19 @@ scm_gc_sweep ()
 		  /* Yes, I really do mean scm_ptobs[k].free */
 		  /* rather than ftobs[k].close.  .close */
 		  /* is for explicit CLOSE-PORT by user */
-		  m += (scm_ptobs[k].free) (scmptr);
+		  mm = scm_ptobs[k].free (scmptr);
+
+		  if (mm != 0)
+		    {
+		      scm_c_issue_deprecation_warning
+			("Returning non-0 from a port free function is "
+			 "deprecated.  Use scm_gc_free et al instead.");
+		      scm_c_issue_deprecation_warning_fmt
+			("(You just returned non-0 while freeing a %s.)",
+			 SCM_PTOBNAME (k));
+		      m += mm;
+		    }
+		    
 		  SCM_SETSTREAM (scmptr, 0);
 		  scm_remove_from_port_table (scmptr);
 		  scm_gc_ports_collected++;
@@ -1713,13 +1732,14 @@ scm_gc_sweep ()
 		  break;
 #ifdef SCM_BIGDIG
 		case scm_tc16_big:
-		  m += (SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG / SCM_CHAR_BIT);
+		  scm_gc_free (SCM_BDIGITS (scmptr),
-		  scm_must_free (SCM_BDIGITS (scmptr));
+			       ((SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG
+				 / SCM_CHAR_BIT)), "bignum");
 		  break;
 #endif /* def SCM_BIGDIG */
 		case scm_tc16_complex:
-		  m += sizeof (scm_t_complex);
+		  scm_gc_free (SCM_COMPLEX_MEM (scmptr), 2*sizeof (double),
-		  scm_must_free (SCM_COMPLEX_MEM (scmptr));
+			       "complex");
 		  break;
 		default:
 		  {
@@ -1730,7 +1750,20 @@ scm_gc_sweep ()
 		      SCM_MISC_ERROR ("undefined smob type", SCM_EOL);
 #endif
 		    if (scm_smobs[k].free)
-		      m += (scm_smobs[k].free) (scmptr);
+		      {
+			size_t mm;
+			mm = scm_smobs[k].free (scmptr);
+			if (mm != 0)
+			  {
+			    scm_c_issue_deprecation_warning
+			      ("Returning non-0 from a smob free function is "
+			       "deprecated.  Use scm_gc_free et al instead.");
+			    scm_c_issue_deprecation_warning_fmt
+			      ("(You just returned non-0 while freeing a %s.)",
+			       SCM_SMOBNAME (k));
+			    m += mm;
+			  }
+		      }
 		    break;
 		  }
 		}
@@ -1814,7 +1847,141 @@ scm_gc_sweep ()
 
 
 
-/* {Front end to malloc}
+/* Function for non-cell memory management.
+ */
+
+void *
+scm_malloc (size_t size)
+{
+  void *ptr;
+
+  if (size == 0)
+    return NULL;
+
+  SCM_SYSCALL (ptr = malloc (size));
+  if (ptr)
+    return ptr;
+
+  scm_igc ("malloc");
+  SCM_SYSCALL (ptr = malloc (size));
+  if (ptr)
+    return ptr;
+
+  scm_memory_error ("malloc");
+}
+
+void *
+scm_realloc (void *mem, size_t size)
+{
+  void *ptr;
+
+  SCM_SYSCALL (ptr = realloc (mem, size));
+  if (ptr)
+    return ptr;
+
+  scm_igc ("realloc");
+  SCM_SYSCALL (ptr = realloc (mem, size));
+  if (ptr)
+    return ptr;
+
+  scm_memory_error ("realloc");
+}
+
+char *
+scm_strndup (const char *str, size_t n)
+{
+  char *dst = scm_malloc (n+1);
+  memcpy (dst, str, n);
+  dst[n] = 0;
+  return dst;
+}
+
+char *
+scm_strdup (const char *str)
+{
+  return scm_strndup (str, strlen (str));
+}
+
+void
+scm_gc_register_collectable_memory (void *mem, size_t size, const char *what)
+{
+  scm_mallocated += size;
+
+  if (scm_mallocated > scm_mtrigger)
+    {
+      scm_igc (what);
+      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;
+	}
+    }
+
+#ifdef GUILE_DEBUG_MALLOC
+  scm_malloc_register (mem, what);
+#endif
+}
+
+void
+scm_gc_unregister_collectable_memory (void *mem, size_t size, const char *what)
+{
+  scm_mallocated -= size;
+
+#ifdef GUILE_DEBUG_MALLOC
+  scm_malloc_unregister (mem);
+#endif
+}
+
+void *
+scm_gc_malloc (size_t size, const char *what)
+{
+  /* XXX - The straightforward implementation below has the problem
+     that it might call the GC twice, once in scm_malloc and then
+     again in scm_gc_register_collectable_memory.  We don't really
+     want the second GC.
+  */
+
+  void *ptr = scm_malloc (size);
+  scm_gc_register_collectable_memory (ptr, size, what);
+  return ptr;
+}
+
+void *
+scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what)
+{
+  /* XXX - see scm_gc_malloc. */
+
+  void *ptr = scm_realloc (mem, new_size);
+  scm_gc_unregister_collectable_memory (mem, old_size, what);
+  scm_gc_register_collectable_memory (ptr, new_size, what);
+  return ptr;
+}
+
+void
+scm_gc_free (void *mem, size_t size, const char *what)
+{
+  scm_gc_unregister_collectable_memory (mem, size, what);
+  free (mem);
+}
+
+char *
+scm_gc_strndup (const char *str, size_t n, const char *what)
+{
+  char *dst = scm_gc_malloc (n+1, what);
+  memcpy (dst, str, n);
+  dst[n] = 0;
+  return dst;
+}
+
+char *
+scm_gc_strdup (const char *str, const char *what)
+{
+  return scm_gc_strndup (str, strlen (str), what);
+}
+
+/* {Deprecated front end to malloc}
  *
  * scm_must_malloc, scm_must_realloc, scm_must_free, scm_done_malloc,
  * scm_done_free
@@ -2660,7 +2827,7 @@ scm_init_storage ()
   j = SCM_HEAP_SEG_SIZE;
   scm_mtrigger = SCM_INIT_MALLOC_LIMIT;
   scm_heap_table = ((scm_t_heap_seg_data *)
-		    scm_must_malloc (sizeof (scm_t_heap_seg_data) * 2, "hplims"));
+		    scm_malloc (sizeof (scm_t_heap_seg_data) * 2));
   heap_segment_table_size = 2;
 
   mark_space_ptr = &mark_space_head;

libguile/gc.h

@@ -326,6 +326,22 @@ SCM_API void scm_gc_mark_dependencies (SCM p);
 SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
 SCM_API int scm_cellp (SCM value);
 SCM_API void scm_gc_sweep (void);
+
+SCM_API void *scm_malloc (size_t size);
+SCM_API void *scm_realloc (void *mem, size_t size);
+SCM_API char *scm_strdup (const char *str);
+SCM_API char *scm_strndup (const char *str, size_t n);
+SCM_API void scm_gc_register_collectable_memory (void *mem, size_t size,
+						 const char *what);
+SCM_API void scm_gc_unregister_collectable_memory (void *mem, size_t size,
+						   const char *what);
+SCM_API void *scm_gc_malloc (size_t size, const char *what);
+SCM_API void *scm_gc_realloc (void *mem, size_t old_size, 
+			      size_t new_size, const char *what);
+SCM_API void scm_gc_free (void *mem, size_t size, const char *what);
+SCM_API char *scm_gc_strdup (const char *str, const char *what);
+SCM_API char *scm_gc_strndup (const char *str, size_t n, const char *what);
+
 SCM_API void * scm_must_malloc (size_t len, const char *what);
 SCM_API void * scm_must_realloc (void *where,
 				 size_t olen, size_t len,

libguile/gh_data.c

@@ -155,7 +155,7 @@ makvect (char *m, size_t len, int type)
 SCM
 gh_chars2byvect (const char *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (char), "vector");
+  char *m = scm_gc_malloc (n * sizeof (char), "vector");
   memcpy (m, d, n * sizeof (char));
   return makvect (m, n, scm_tc7_byvect);
 }
@@ -163,7 +163,7 @@ gh_chars2byvect (const char *d, long n)
 SCM
 gh_shorts2svect (const short *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (short), "vector");
+  char *m = scm_gc_malloc (n * sizeof (short), "vector");
   memcpy (m, d, n * sizeof (short));
   return makvect (m, n, scm_tc7_svect);
 }
@@ -171,7 +171,7 @@ gh_shorts2svect (const short *d, long n)
 SCM
 gh_longs2ivect (const long *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (long), "vector");
+  char *m = scm_gc_malloc (n * sizeof (long), "vector");
   memcpy (m, d, n * sizeof (long));
   return makvect (m, n, scm_tc7_ivect);
 }
@@ -179,7 +179,7 @@ gh_longs2ivect (const long *d, long n)
 SCM
 gh_ulongs2uvect (const unsigned long *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (unsigned long), "vector");
+  char *m = scm_gc_malloc (n * sizeof (unsigned long), "vector");
   memcpy (m, d, n * sizeof (unsigned long));
   return makvect (m, n, scm_tc7_uvect);
 }
@@ -187,7 +187,7 @@ gh_ulongs2uvect (const unsigned long *d, long n)
 SCM
 gh_floats2fvect (const float *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (float), "vector");
+  char *m = scm_gc_malloc (n * sizeof (float), "vector");
   memcpy (m, d, n * sizeof (float));
   return makvect (m, n, scm_tc7_fvect);
 }
@@ -195,7 +195,7 @@ gh_floats2fvect (const float *d, long n)
 SCM
 gh_doubles2dvect (const double *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (double), "vector");
+  char *m = scm_gc_malloc (n * sizeof (double), "vector");
   memcpy (m, d, n * sizeof (double));
   return makvect (m, n, scm_tc7_dvect);
 }

libguile/goops.c

@@ -495,7 +495,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
     SCM_MISC_ERROR ("class object doesn't have enough fields: ~S",
 		    scm_list_1 (nfields));
   
-  s = n > 0 ? scm_must_malloc (n, FUNC_NAME) : 0;
+  s = n > 0 ? scm_malloc (n) : 0;
   for (i = 0; i < n; i += 2)
     {
       long len;
@@ -544,7 +544,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
     }
   SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n));
   if (s)
-    scm_must_free (s);
+    free (s);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -577,7 +577,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0,
       long n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
 #if 0
       /*
-       * We could avoid calling scm_must_malloc in the allocation code
+       * We could avoid calling scm_gc_malloc in the allocation code
        * (in which case the following two lines are needed).  Instead
        * we make 0-slot instances non-light, so that the light case
        * can be handled without special cases.
@@ -1326,7 +1326,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
   if (SCM_CLASS_FLAGS (class) & SCM_STRUCTF_LIGHT)
     {
       n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
-      m = (SCM *) scm_must_malloc (n * sizeof (SCM), "instance");
+      m = (SCM *) scm_gc_malloc (n * sizeof (SCM), "struct");
       return wrap_init (class, m, n);
     }
   
@@ -1339,9 +1339,8 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
   /* Entities */
   if (SCM_CLASS_FLAGS (class) & SCM_CLASSF_ENTITY)
     {
-      m = (SCM *) scm_alloc_struct (n,
+      m = (SCM *) scm_alloc_struct (n, scm_struct_entity_n_extra_words,
-				    scm_struct_entity_n_extra_words,
+				    "entity struct");
-				    "entity");
       m[scm_struct_i_setter] = SCM_BOOL_F;
       m[scm_struct_i_procedure] = SCM_BOOL_F;
       /* Generic functions */
@@ -1377,9 +1376,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
   
   /* Non-light instances */
   {
-    m = (SCM *) scm_alloc_struct (n,
+    m = (SCM *) scm_alloc_struct (n, scm_struct_n_extra_words, "heavy struct");
-				  scm_struct_n_extra_words,
-				  "heavy instance");
     return wrap_init (class, m, n);
   }
 }
@@ -1504,7 +1501,7 @@ go_to_hell (void *o)
   if (n_hell == hell_size)
     {
       long new_size = 2 * hell_size;
-      hell = scm_must_realloc (hell, hell_size, new_size, "hell");
+      hell = scm_realloc (hell, new_size);
       hell_size = new_size;
     }
   hell[n_hell++] = SCM_STRUCT_DATA (obj);
@@ -2683,7 +2680,7 @@ scm_init_goops_builtins (void)
 
   list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method));
 
-  hell = scm_must_malloc (hell_size, "hell");
+  hell = scm_malloc (hell_size);
 #ifdef USE_THREADS
   scm_mutex_init (&hell_mutex);
 #endif

libguile/guardians.c

@@ -175,8 +175,8 @@ guardian_mark (SCM ptr)
 static size_t
 guardian_free (SCM ptr)
 {
-  scm_must_free (GUARDIAN_DATA (ptr));
+  scm_gc_free (GUARDIAN_DATA (ptr), sizeof (t_guardian), "guardian");
-  return sizeof (t_guardian);
+  return 0;
 }
 
 
@@ -330,7 +330,7 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 1, 0,
             "paper still (mostly) accurately describes the interface).")
 #define FUNC_NAME s_scm_make_guardian
 {
-  t_guardian *g = SCM_MUST_MALLOC_TYPE (t_guardian);
+  t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian");
   SCM z1 = scm_cons (SCM_BOOL_F, SCM_EOL);
   SCM z2 = scm_cons (SCM_BOOL_F, SCM_EOL);
   SCM z;

libguile/hooks.c

@@ -77,8 +77,7 @@ scm_c_hook_add (scm_t_c_hook *hook,
 		void *func_data, 
 		int appendp)
 {
-  scm_t_c_hook_entry *entry = scm_must_malloc (sizeof (scm_t_c_hook_entry),
+  scm_t_c_hook_entry *entry = scm_malloc (sizeof (scm_t_c_hook_entry));
-					     "C level hook entry");
   scm_t_c_hook_entry **loc = &hook->first;
   if (appendp)
     while (*loc)
@@ -101,7 +100,7 @@ scm_c_hook_remove (scm_t_c_hook *hook,
 	{
 	  scm_t_c_hook_entry *entry = *loc;
 	  *loc = (*loc)->next;
-	  scm_must_free (entry);
+	  free (entry);
 	  return;
 	}
       loc = &(*loc)->next;

libguile/init.c

@@ -180,7 +180,7 @@ start_stack (void *base)
   /* Create an object to hold the root continuation.
    */
   {
-    scm_t_contregs *contregs = scm_must_malloc (sizeof (scm_t_contregs),
+    scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs),
 					      "continuation");
     contregs->num_stack_items = 0;
     contregs->seq = 0;

libguile/keywords.c

@@ -95,14 +95,13 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
 SCM
 scm_c_make_keyword (char *s)
 {
-  char *buf = scm_must_malloc (strlen (s) + 2, "keyword");
+  char *buf = scm_malloc (strlen (s) + 2);
   SCM symbol;
 
   buf[0] = '-';
   strcpy (buf + 1, s);
   symbol = scm_str2symbol (buf);
-  scm_must_free (buf);
+  free (buf);
-  scm_done_free (strlen (s) + 2);
 
   return scm_make_keyword_from_dash_symbol (symbol);
 }

libguile/load.c

@@ -354,7 +354,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
   { /* scope */
     SCM result = SCM_BOOL_F;
     size_t buf_size = max_path_len + 1 + filename_len + max_ext_len + 1;
-    char *buf = SCM_MUST_MALLOC (buf_size);
+    char *buf = scm_malloc (buf_size);
 
     /* This simplifies the loop below a bit.  */
     if (SCM_NULL_OR_NIL_P (extensions))
@@ -400,8 +400,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 1, 0,
       }
 
   end:
-    scm_must_free (buf);
+    free (buf);
-    scm_done_free (buf_size);
     SCM_ALLOW_INTS;
     return result;
   }

libguile/numbers.c

@@ -1388,7 +1388,7 @@ scm_i_mkbig (size_t nlen, int sign)
   if (((nlen << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD) != nlen)
     scm_memory_error (s_bignum);
 
-  base = scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum);
+  base = scm_gc_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum);
 
   v = scm_alloc_cell (SCM_MAKE_BIGNUM_TAG (nlen, sign), (scm_t_bits) base);
   return v;
@@ -1424,9 +1424,9 @@ scm_i_adjbig (SCM b, size_t nlen)
   {
     SCM_BIGDIG *digits
       = ((SCM_BIGDIG *)
-	 scm_must_realloc ((char *) SCM_BDIGITS (b),
+	 scm_gc_realloc (SCM_BDIGITS (b),
-			   (long) (SCM_NUMDIGS (b) * sizeof (SCM_BIGDIG)),
+			 SCM_NUMDIGS (b) * sizeof (SCM_BIGDIG),
-			   (long) (nsiz * sizeof (SCM_BIGDIG)), s_bignum));
+			 nsiz * sizeof (SCM_BIGDIG), s_bignum));
 
     SCM_SET_BIGNUM_BASE (b, digits);
     SCM_SETNUMDIGS (b, nsiz, SCM_BIGSIGN (b));
@@ -2840,7 +2840,8 @@ scm_make_complex (double x, double y)
     return scm_make_real (x);
   } else {
     SCM z;
-    SCM_NEWSMOB (z, scm_tc16_complex, scm_must_malloc (2L * sizeof (double), "complex"));
+    SCM_NEWSMOB (z, scm_tc16_complex, scm_gc_malloc (2*sizeof (double),
+						     "complex"));
     SCM_COMPLEX_REAL (z) = x;
     SCM_COMPLEX_IMAG (z) = y;
     return z;

libguile/ports.c

@@ -124,6 +124,12 @@ end_input_default (SCM port SCM_UNUSED, int offset SCM_UNUSED)
 {
 }
 
+static size_t
+scm_port_free0 (SCM port)
+{
+  return 0;
+}
+
 scm_t_bits
 scm_make_port_type (char *name,
 		    int (*fill_input) (SCM port),
@@ -142,7 +148,7 @@ scm_make_port_type (char *name,
 
       scm_ptobs[scm_numptob].name = name;
       scm_ptobs[scm_numptob].mark = 0;
-      scm_ptobs[scm_numptob].free = scm_free0;
+      scm_ptobs[scm_numptob].free = scm_port_free0;
       scm_ptobs[scm_numptob].print = scm_port_print;
       scm_ptobs[scm_numptob].equalp = 0;
       scm_ptobs[scm_numptob].close = 0;
@@ -455,17 +461,15 @@ scm_add_to_port_table (SCM port)
 
   if (scm_port_table_size == scm_port_table_room)
     {
-      /* initial malloc is in gc.c.  this doesn't use scm_must_malloc etc.,
+      /* initial malloc is in gc.c.  this doesn't use scm_gc_malloc etc.,
 	 since it can never be freed during gc.  */
-      void *newt = realloc ((char *) scm_port_table,
+      void *newt = scm_realloc ((char *) scm_port_table,
 				(size_t) (sizeof (scm_t_port *)
 					  * scm_port_table_room * 2));
-      if (newt == NULL)
-	scm_memory_error ("scm_add_to_port_table");
       scm_port_table = (scm_t_port **) newt;
       scm_port_table_room *= 2;
     }
-  entry = (scm_t_port *) scm_must_malloc (sizeof (scm_t_port), FUNC_NAME);
+  entry = (scm_t_port *) scm_gc_malloc (sizeof (scm_t_port), "port");
 
   entry->port = port;
   entry->entry = scm_port_table_size;
@@ -498,8 +502,8 @@ scm_remove_from_port_table (SCM port)
   if (i >= scm_port_table_size)
     SCM_MISC_ERROR ("Port not in table: ~S", scm_list_1 (port));
   if (p->putback_buf)
-    scm_must_free (p->putback_buf);
+    scm_gc_free (p->putback_buf, p->putback_buf_size, "putback buffer");
-  scm_must_free (p);
+  scm_gc_free (p, sizeof (scm_t_port), "port");
   /* Since we have just freed slot i we can shrink the table by moving
      the last entry to that slot... */
   if (i < scm_port_table_size - 1)
@@ -1098,8 +1102,8 @@ scm_ungetc (int c, SCM port)
 	{
 	  size_t new_size = pt->read_buf_size * 2;
 	  unsigned char *tmp = (unsigned char *)
-	    scm_must_realloc (pt->putback_buf, pt->read_buf_size, new_size,
+	    scm_gc_realloc (pt->putback_buf, pt->read_buf_size, new_size,
-			      FUNC_NAME);
+			    "putback buffer");
 
 	  pt->read_pos = pt->read_buf = pt->putback_buf = tmp;
 	  pt->read_end = pt->read_buf + pt->read_buf_size;
@@ -1125,8 +1129,8 @@ scm_ungetc (int c, SCM port)
       if (pt->putback_buf == NULL)
 	{
 	  pt->putback_buf
-	    = (unsigned char *) scm_must_malloc (SCM_INITIAL_PUTBACK_BUF_SIZE,
+	    = (unsigned char *) scm_gc_malloc (SCM_INITIAL_PUTBACK_BUF_SIZE,
-						 FUNC_NAME);
+					       "putback buffer");
 	  pt->putback_buf_size = SCM_INITIAL_PUTBACK_BUF_SIZE;
 	}
 

libguile/posix.c

@@ -232,16 +232,14 @@ SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
     SCM_SYSERROR;
 
   size = ngroups * sizeof (GETGROUPS_T);
-  groups = scm_must_malloc (size, FUNC_NAME);
+  groups = scm_malloc (size);
   getgroups (ngroups, groups);
 
   ans = scm_c_make_vector (ngroups, SCM_UNDEFINED);
   while (--ngroups >= 0) 
     SCM_VELTS (ans) [ngroups] = SCM_MAKINUM (groups [ngroups]);
 
-  scm_must_free (groups);
+  free (groups);
-  scm_done_free (size);
-
   return ans;
 }
 #undef FUNC_NAME  
@@ -842,7 +840,7 @@ scm_convert_exec_args (SCM args, int argn, const char *subr)
 
   argc = scm_ilength (args);
   SCM_ASSERT (argc >= 0, args, argn, subr);
-  argv = (char **) scm_must_malloc ((argc + 1) * sizeof (char *), subr);
+  argv = (char **) scm_malloc ((argc + 1) * sizeof (char *));
   for (i = 0; !SCM_NULLP (args); args = SCM_CDR (args), ++i)
     {
       SCM arg = SCM_CAR (args);
@@ -853,7 +851,7 @@ scm_convert_exec_args (SCM args, int argn, const char *subr)
       SCM_ASSERT (SCM_STRINGP (arg), args, argn, subr);
       len = SCM_STRING_LENGTH (arg);
       src = SCM_STRING_CHARS (arg);
-      dst = (char *) scm_must_malloc (len + 1, subr);
+      dst = (char *) scm_malloc (len + 1);
       memcpy (dst, src, len);
       dst[len] = 0;
       argv[i] = dst;
@@ -1635,23 +1633,23 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
   /* 256 is for Solaris, under Linux ENAMETOOLONG is returned if not
      large enough.  */
   int len = 256, res;
-  char *p = scm_must_malloc (len, "gethostname");
+  char *p = scm_malloc (len);
   SCM name;
 
   res = gethostname (p, len);
   while (res == -1 && errno == ENAMETOOLONG)
     {
-      p = scm_must_realloc (p, len, len * 2, "gethostname");
+      p = scm_realloc (p, len * 2);
       len *= 2;
       res = gethostname (p, len);
     }
   if (res == -1)
     {
-      scm_must_free (p);
+      free (p);
       SCM_SYSERROR;
     }
   name = scm_makfrom0str (p);
-  scm_must_free (p);
+  free (p);
   return name;
 }
 #undef FUNC_NAME

libguile/procs.c

@@ -78,10 +78,8 @@ scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
     {
       long new_size = scm_subr_table_room * 3 / 2;
       void *new_table
-	= scm_must_realloc ((char *) scm_subr_table,
+	= scm_realloc ((char *) scm_subr_table,
-			    sizeof (scm_t_subr_entry) * scm_subr_table_room,
+		       sizeof (scm_t_subr_entry) * new_size);
-			    sizeof (scm_t_subr_entry) * new_size, 
-			    "scm_subr_table");
       scm_subr_table = new_table;
       scm_subr_table_room = new_size;
     }
@@ -154,7 +152,8 @@ scm_mark_subr_table ()
 SCM 
 scm_makcclo (SCM proc, size_t len)
 {
-  scm_t_bits *base = scm_must_malloc (len * sizeof (scm_t_bits), "compiled-closure");
+  scm_t_bits *base = scm_gc_malloc (len * sizeof (scm_t_bits),
+				    "compiled closure");
   unsigned long i;
   SCM s;
 
@@ -376,8 +375,7 @@ scm_init_subr_table ()
 {
   scm_subr_table
     = ((scm_t_subr_entry *)
-       scm_must_malloc (sizeof (scm_t_subr_entry) * scm_subr_table_room,
+       scm_malloc (sizeof (scm_t_subr_entry) * scm_subr_table_room));
-			"scm_subr_table"));
 }
 
 void

libguile/rdelim.c

@@ -136,7 +136,7 @@ scm_do_read_line (SCM port, size_t *len_p)
     {
       size_t buf_len = (end + 1) - pt->read_pos;
       /* Allocate a buffer of the perfect size.  */
-      unsigned char *buf = scm_must_malloc (buf_len + 1, "%read-line");
+      unsigned char *buf = scm_malloc (buf_len + 1);
 
       memcpy (buf, pt->read_pos, buf_len);
       pt->read_pos += buf_len;
@@ -155,7 +155,7 @@ scm_do_read_line (SCM port, size_t *len_p)
     size_t buf_size = (len < 50) ? 60 : len * 2;
     /* Invariant: buf always has buf_size + 1 characters allocated;
        the `+ 1' is for the final '\0'.  */
-    unsigned char *buf = scm_must_malloc (buf_size + 1, "%read-line");
+    unsigned char *buf = scm_malloc (buf_size + 1);
     size_t buf_len = 0;
 
     for (;;)
@@ -163,8 +163,7 @@ scm_do_read_line (SCM port, size_t *len_p)
 	if (buf_len + len > buf_size)
 	  {
 	    size_t new_size = (buf_len + len) * 2;
-	    buf = scm_must_realloc (buf, buf_size + 1, new_size + 1,
+	    buf = scm_realloc (buf, new_size + 1);
-				    "%read-line");
 	    buf_size = new_size;
 	  }
 
@@ -197,7 +196,7 @@ scm_do_read_line (SCM port, size_t *len_p)
       }
 
     /* I wonder how expensive this realloc is.  */
-    buf = scm_must_realloc (buf, buf_size + 1, buf_len + 1, "%read-line");
+    buf = scm_realloc (buf, buf_len + 1);
     buf[buf_len] = '\0';
     *len_p = buf_len;
     return buf;
@@ -247,7 +246,6 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
 	  term = SCM_MAKE_CHAR ('\n');
 	  s[slen-1] = '\0';
 	  line = scm_take_str (s, slen-1);
-	  scm_done_free (1);
 	  SCM_INCLINE (port);
 	}
       else

libguile/regex-posix.c

@@ -95,8 +95,8 @@ static size_t
 regex_free (SCM obj)
 {
   regfree (SCM_RGX (obj));
-  free (SCM_RGX (obj));
+  scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
-  return sizeof(regex_t);
+  return 0;
 }
 
 
@@ -202,7 +202,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
       flag = SCM_CDR (flag);
     }
 
-  rx = SCM_MUST_MALLOC_TYPE (regex_t);
+  rx = scm_gc_malloc (sizeof(regex_t), "regex");
   status = regcomp (rx, SCM_STRING_CHARS (pat),
 		    /* Make sure they're not passing REG_NOSUB;
                        regexp-exec assumes we're getting match data.  */
@@ -260,7 +260,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
 
   nmatches = SCM_RGX(rx)->re_nsub + 1;
   SCM_DEFER_INTS;
-  matches = SCM_MUST_MALLOC_TYPE_NUM (regmatch_t,nmatches);
+  matches = scm_malloc (sizeof (regmatch_t) * nmatches);
   status = regexec (SCM_RGX (rx), SCM_STRING_CHARS (str) + offset,
 		    nmatches, matches,
 		    SCM_INUM (flags));
@@ -279,7 +279,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
 	    = scm_cons (scm_long2num (matches[i].rm_so + offset),
 			scm_long2num (matches[i].rm_eo + offset));
     }
-  scm_must_free ((char *) matches);
+  free (matches);
   SCM_ALLOW_INTS;
 
   if (status != 0 && status != REG_NOMATCH)

libguile/root.c

@@ -105,8 +105,8 @@ scm_make_root (SCM parent)
   SCM root;
   scm_root_state *root_state;
 
-  root_state = (scm_root_state *) scm_must_malloc (sizeof (scm_root_state),
+  root_state = (scm_root_state *) scm_gc_malloc (sizeof (scm_root_state),
-						   "scm_make_root");
+						 "root state");
   if (SCM_ROOTP (parent))
     {
       memcpy (root_state, SCM_ROOT_STATE (parent), sizeof (scm_root_state));
@@ -247,8 +247,8 @@ scm_internal_cwdr (scm_t_catch_body body, void *body_data,
 
     SCM_REDEFER_INTS;
     {
-      scm_t_contregs *contregs = scm_must_malloc (sizeof (scm_t_contregs),
+      scm_t_contregs *contregs = scm_gc_malloc (sizeof (scm_t_contregs),
-						"inferior root continuation");
+						"continuation");
 
       contregs->num_stack_items = 0;
       contregs->dynenv = SCM_EOL;

libguile/smob.c

@@ -107,8 +107,11 @@ scm_free0 (SCM ptr SCM_UNUSED)
 size_t
 scm_smob_free (SCM obj)
 {
-  scm_must_free ((char *) SCM_CELL_WORD_1 (obj));
+  long n = SCM_SMOBNUM (obj);
-  return scm_smobs[SCM_SMOBNUM (obj)].size;
+  if (scm_smobs[n].size > 0)
+    scm_gc_free ((void *) SCM_CELL_WORD_1 (obj), 
+		 scm_smobs[n].size, SCM_SMOBNAME (n));
+  return 0;
 }
 
 /* {Print}
@@ -457,7 +460,7 @@ scm_make_smob (scm_t_bits tc)
   long n = SCM_TC2SMOBNUM (tc);
   size_t size = scm_smobs[n].size;
   scm_t_bits data = (size > 0
-		     ? (scm_t_bits) scm_must_malloc (size, SCM_SMOBNAME (n))
+		     ? (scm_t_bits) scm_gc_malloc (size, SCM_SMOBNAME (n))
 		     : 0);
   return scm_alloc_cell (tc, data);
 }

libguile/stime.c

@@ -314,7 +314,7 @@ setzone (SCM zone, int pos, const char *subr)
       char *buf;
 
       SCM_ASSERT (SCM_STRINGP (zone), zone, pos, subr);
-      buf = scm_must_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1, subr);
+      buf = scm_malloc (SCM_STRING_LENGTH (zone) + sizeof (tzvar) + 1);
       sprintf (buf, "%s=%s", tzvar, SCM_STRING_CHARS (zone));
       oldenv = environ;
       tmpenv[0] = buf;
@@ -329,7 +329,7 @@ restorezone (SCM zone, char **oldenv, const char *subr SCM_UNUSED)
 {
   if (!SCM_UNBNDP (zone))
     {
-      scm_must_free (environ[0]);
+      free (environ[0]);
       environ = oldenv;
 #ifdef HAVE_TZSET
       /* for the possible benefit of user code linked with libguile.  */
@@ -378,7 +378,7 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
 #else
       ptr = "";
 #endif
-      zname = SCM_MUST_MALLOC (strlen (ptr) + 1);
+      zname = scm_malloc (strlen (ptr) + 1);
       strcpy (zname, ptr);
     }
   /* the struct is copied in case localtime and gmtime share a buffer.  */
@@ -407,7 +407,8 @@ SCM_DEFINE (scm_localtime, "localtime", 1, 1, 0,
 
   result = filltime (&lt, zoff, zname);
   SCM_ALLOW_INTS;
-  scm_must_free (zname);
+  if (zname)
+    free (zname);
   return result;
 }
 #undef FUNC_NAME
@@ -511,7 +512,7 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
 #else
       ptr = "";
 #endif
-      zname = SCM_MUST_MALLOC (strlen (ptr) + 1);
+      zname = scm_malloc (strlen (ptr) + 1);
       strcpy (zname, ptr);
     }
 
@@ -540,7 +541,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
   result = scm_cons (scm_long2num ((long) itime),
 		     filltime (&lt, zoff, zname));
   SCM_ALLOW_INTS;
-  scm_must_free (zname);
+  if (zname)
+    free (zname);
   return result;
 }
 #undef FUNC_NAME
@@ -590,12 +592,12 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
      a zero-byte output string!  Workaround is to prepend a junk
      character to the format string, so that valid returns are always
      nonzero. */
-  myfmt = SCM_MUST_MALLOC (len+2);
+  myfmt = scm_malloc (len+2);
   *myfmt = 'x';
   strncpy(myfmt+1, fmt, len);
   myfmt[len+1] = 0;
 
-  tbuf = SCM_MUST_MALLOC (size);
+  tbuf = scm_malloc (size);
   {
 #if !defined (HAVE_TM_ZONE)
     /* it seems the only way to tell non-GNU versions of strftime what
@@ -632,9 +634,9 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
        case. */
     while ((len = strftime (tbuf, size, myfmt, &t)) == 0 || len == size)
       {
-	scm_must_free (tbuf);
+	free (tbuf);
 	size *= 2;
-	tbuf = SCM_MUST_MALLOC (size);
+	tbuf = scm_malloc (size);
       }
 
 #if !defined (HAVE_TM_ZONE)
@@ -647,8 +649,8 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
     }
 
   result = scm_mem2string (tbuf + 1, len - 1);
-  scm_must_free (tbuf);
+  free (tbuf);
-  scm_must_free(myfmt);
+  free (myfmt);
   return result;
 }
 #undef FUNC_NAME

libguile/strings.c

@@ -133,7 +133,7 @@ scm_take_str (char *s, size_t len)
   SCM_ASSERT_RANGE (2, scm_ulong2num (len), len <= SCM_STRING_MAX_LENGTH);
 
   answer = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) s);
-  scm_done_malloc (len + 1);
+  scm_gc_register_collectable_memory (s, len+1, "string");
 
   return answer;
 }
@@ -191,7 +191,7 @@ scm_allocate_string (size_t len)
 
   SCM_ASSERT_RANGE (1, scm_long2num (len), len <= SCM_STRING_MAX_LENGTH);
 
-  mem = (char *) scm_must_malloc (len + 1, FUNC_NAME);
+  mem = (char *) scm_gc_malloc (len + 1, "string");
   mem[len] = 0;
 
   s = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) mem);

libguile/struct.c

@@ -306,10 +306,10 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
 
 
 scm_t_bits *
-scm_alloc_struct (int n_words, int n_extra, char *who)
+scm_alloc_struct (int n_words, int n_extra, const char *what)
 {
   int size = sizeof (scm_t_bits) * (n_words + n_extra) + 7;
-  void * block = scm_must_malloc (size, who);
+  void * block = scm_gc_malloc (size, what);
 
   /* Adjust the pointer to hide the extra words.  */
   scm_t_bits * p = (scm_t_bits *) block + n_extra;
@@ -326,36 +326,33 @@ scm_alloc_struct (int n_words, int n_extra, char *who)
   return p;
 }
 
-size_t
+void
 scm_struct_free_0 (scm_t_bits * vtable SCM_UNUSED,
 		   scm_t_bits * data SCM_UNUSED)
 {
-  return 0;
 }
 
-size_t
+void
 scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data)
 {
-  scm_must_free (data);
+  size_t n = vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK;
-  return vtable [scm_struct_i_size] & ~SCM_STRUCTF_MASK;
+  scm_gc_free (data, n, "struct");
 }
 
-size_t
+void
 scm_struct_free_standard (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data)
 {
   size_t n = (data[scm_struct_i_n_words] + scm_struct_n_extra_words)
 	     * sizeof (scm_t_bits) + 7;
-  scm_must_free ((void *) data[scm_struct_i_ptr]);
+  scm_gc_free ((void *) data[scm_struct_i_ptr], n, "heavy struct");
-  return n;
 }
 
-size_t
+void
 scm_struct_free_entity (scm_t_bits * vtable SCM_UNUSED, scm_t_bits * data)
 {
   size_t n = (data[scm_struct_i_n_words] + scm_struct_entity_n_extra_words)
 	     * sizeof (scm_t_bits) + 7;
-  scm_must_free ((void *) data[scm_struct_i_ptr]);
+  scm_gc_free ((void *) data[scm_struct_i_ptr], n, "entity struct");
-  return n;
 }
 
 static void *
@@ -455,14 +452,14 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
     {
       data = scm_alloc_struct (basic_size + tail_elts,
 			       scm_struct_entity_n_extra_words,
-			       "make-struct");
+			       "entity struct");
       data[scm_struct_i_procedure] = SCM_UNPACK (SCM_BOOL_F);
       data[scm_struct_i_setter] = SCM_UNPACK (SCM_BOOL_F);
     }
   else
     data = scm_alloc_struct (basic_size + tail_elts,
 			     scm_struct_n_extra_words,
-			     "make-struct");
+			     "struct");
   handle = scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (vtable))
 				   + scm_tc3_struct),
 				  (scm_t_bits) data, 0, 0);
@@ -541,7 +538,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
   SCM_DEFER_INTS;
   data = scm_alloc_struct (basic_size + tail_elts,
 			   scm_struct_n_extra_words,
-			   "make-vtable-vtable");
+			   "struct");
   handle = scm_alloc_double_cell ((scm_t_bits) data + scm_tc3_struct,
 				  (scm_t_bits) data, 0, 0);
   data [scm_vtable_index_layout] = SCM_UNPACK (layout);

libguile/struct.h

@@ -71,7 +71,7 @@
 #define scm_vtable_index_printer 2 /* A printer for this struct type. */
 #define scm_vtable_offset_user   3 /* Where do user fields start? */
 
-typedef size_t (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data);
+typedef void (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data);
 
 #define SCM_STRUCTF_MASK   (0xFFF << 20)
 #define SCM_STRUCTF_ENTITY (1L << 30) /* Indicates presence of proc slots */
@@ -107,11 +107,12 @@ SCM_API SCM scm_structs_to_free;
 
 
 
-SCM_API scm_t_bits * scm_alloc_struct (int n_words, int n_extra, char * who);
+SCM_API scm_t_bits * scm_alloc_struct (int n_words, int n_extra,
-SCM_API size_t scm_struct_free_0 (scm_t_bits * vtable, scm_t_bits * data);
+				       const char *what);
-SCM_API size_t scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data);
+SCM_API void scm_struct_free_0 (scm_t_bits * vtable, scm_t_bits * data);
-SCM_API size_t scm_struct_free_standard (scm_t_bits * vtable, scm_t_bits * data);
+SCM_API void scm_struct_free_light (scm_t_bits * vtable, scm_t_bits * data);
-SCM_API size_t scm_struct_free_entity (scm_t_bits * vtable, scm_t_bits * data);
+SCM_API void scm_struct_free_standard (scm_t_bits * vtable, scm_t_bits * data);
+SCM_API void scm_struct_free_entity (scm_t_bits * vtable, scm_t_bits * data);
 SCM_API SCM scm_make_struct_layout (SCM fields);
 SCM_API SCM scm_struct_p (SCM x);
 SCM_API SCM scm_struct_vtable_p (SCM x);

libguile/symbols.c

@@ -126,7 +126,8 @@ scm_mem2symbol (const char *name, size_t len)
     SCM slot;
 
     symbol = scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len),
-				    (scm_t_bits) scm_must_strndup (name, len),
+				    (scm_t_bits) scm_gc_strndup (name, len,
+								 "symbol"),
 				    raw_hash,
 				    SCM_UNPACK (scm_cons (SCM_BOOL_F,
 							  SCM_EOL)));
@@ -146,7 +147,8 @@ scm_mem2uninterned_symbol (const char *name, size_t len)
 		     + SCM_T_BITS_MAX/2 + 1);
 
   return scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len),
-				(scm_t_bits) scm_must_strndup (name, len),
+				(scm_t_bits) scm_gc_strndup (name, len, 
+							     "symbol"),
 				raw_hash,
 				SCM_UNPACK (scm_cons (SCM_BOOL_F,
 						      SCM_EOL)));
@@ -291,14 +293,14 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
       SCM_VALIDATE_STRING (1, prefix);
       len = SCM_STRING_LENGTH (prefix);
       if (len > MAX_PREFIX_LENGTH)
-	name = SCM_MUST_MALLOC (len + SCM_INTBUFLEN);
+	name = scm_malloc (len + SCM_INTBUFLEN);
       memcpy (name, SCM_STRING_CHARS (prefix), len);
     }
   {
     int n_digits = scm_iint2str (gensym_counter++, 10, &name[len]);
     SCM res = scm_mem2symbol (name, len + n_digits);
     if (name != buf)
-      scm_must_free (name);
+      free (name);
     return res;
   }
 }

libguile/unif.c

@@ -171,7 +171,7 @@ scm_make_uve (long k, SCM prot)
 			    scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
 	  i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
 	  v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (k), 
-			      (scm_t_bits) scm_must_malloc (i, "vector"));
+			      (scm_t_bits) scm_gc_malloc (i, "vector"));
 	}
       else
 	v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (0), 0);
@@ -240,7 +240,7 @@ scm_make_uve (long k, SCM prot)
   SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
 
   return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (k, type),
-			 (scm_t_bits) scm_must_malloc (i ? i : 1, "vector"));
+			 (scm_t_bits) scm_gc_malloc (i, "vector"));
 }
 #undef FUNC_NAME
 
@@ -520,7 +520,7 @@ scm_make_ra (int ndim)
   SCM ra;
   SCM_DEFER_INTS;
   SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_tc16_array,
-              scm_must_malloc ((sizeof (scm_t_array) +
+              scm_gc_malloc ((sizeof (scm_t_array) +
 			      ndim * sizeof (scm_t_array_dim)),
 			     "array"));
   SCM_ARRAY_V (ra) = scm_nullvect;
@@ -2589,9 +2589,11 @@ array_mark (SCM ptr)
 static size_t
 array_free (SCM ptr)
 {
-  scm_must_free (SCM_ARRAY_MEM (ptr));
+  scm_gc_free (SCM_ARRAY_MEM (ptr),
-  return sizeof (scm_t_array) +
+	       (sizeof (scm_t_array) 
-    SCM_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim);
+		+ SCM_ARRAY_NDIM (ptr) * sizeof (scm_t_array_dim)),
+	       "array");
+  return 0;
 }
 
 void

libguile/vectors.c

@@ -208,7 +208,7 @@ scm_c_make_vector (unsigned long int k, SCM fill)
 
       SCM_ASSERT_RANGE (1, scm_ulong2num (k), k <= SCM_VECTOR_MAX_LENGTH);
 
-      base = scm_must_malloc (k * sizeof (scm_t_bits), FUNC_NAME);
+      base = scm_gc_malloc (k * sizeof (scm_t_bits), "vector");
       for (j = 0; j != k; ++j)
 	base[j] = SCM_UNPACK (fill);
     }

libguile/weaks.c

@@ -81,7 +81,7 @@ allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller)
 	    fill = SCM_UNSPECIFIED;
 
 	  SCM_ASSERT_RANGE (1, size, c_size <= SCM_VECTOR_MAX_LENGTH);
-	  base = scm_must_malloc (c_size * sizeof (scm_t_bits), FUNC_NAME);
+	  base = scm_gc_malloc (c_size * sizeof (scm_t_bits), "weak vector");
 	  for (j = 0; j != c_size; ++j)
 	    base[j] = SCM_UNPACK (fill);
 	  v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (c_size,