/[guile]/guile/guile-core/libguile/debug-malloc.c
ViewVC logotype

Diff of /guile/guile-core/libguile/debug-malloc.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by kei, Thu Apr 12 01:40:20 2001 UTC revision 1.10 by mvo, Mon Feb 11 18:06:49 2002 UTC
# Line 183  scm_malloc_unregister (void *obj) Line 183  scm_malloc_unregister (void *obj)
183    if (type == 0)    if (type == 0)
184      {      {
185        fprintf (stderr,        fprintf (stderr,
186                 "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");
187        abort ();        abort ();
188      }      }
189    type->data = (void *) ((int) type->data - 1);    type->data = (void *) ((int) type->data - 1);
# Line 194  void Line 194  void
194  scm_malloc_reregister (void *old, void *new, const char *newwhat)  scm_malloc_reregister (void *old, void *new, const char *newwhat)
195  {  {
196    hash_entry_t *object, *type;    hash_entry_t *object, *type;
197    GET_CREATE_HASH_ENTRY (object, object, old, l1);  
198    type = (hash_entry_t *) object->data;    if (old == NULL)
199    if (type == 0)      scm_malloc_register (new, newwhat);
200      {    else
       fprintf (stderr,  
                "scm_must_realloc called on object not allocated with scm_must_malloc\n");  
       abort ();  
     }  
   if (strcmp ((char *) type->key, newwhat) != 0)  
201      {      {
202        if (strcmp (newwhat, "vector-set-length!") != 0)        GET_CREATE_HASH_ENTRY (object, object, old, l1);
203          type = (hash_entry_t *) object->data;
204          if (type == 0)
205          {          {
206            fprintf (stderr,            fprintf (stderr,
207                     "scm_must_realloc called with arg %s, was %s\n",                     "scm_gc_realloc called on object not allocated "
208                     newwhat,                     "with scm_gc_malloc\n");
                    (char *) type->key);  
209            abort ();            abort ();
210          }          }
211      }        if (strcmp ((char *) type->key, newwhat) != 0)
212    if (new != old)          {
213      {            if (strcmp (newwhat, "vector-set-length!") != 0)
214        object->key = 0;              {
215        CREATE_HASH_ENTRY (object, new, type, l2);                fprintf (stderr,
216                           "scm_gc_realloc called with arg %s, was %s\n",
217                           newwhat,
218                           (char *) type->key);
219                  abort ();
220                }
221            }
222          if (new != old)
223            {
224              object->key = 0;
225              CREATE_HASH_ENTRY (object, new, type, l2);
226            }
227      }      }
228  }  }
229    
# Line 224  SCM_DEFINE (scm_malloc_stats, "malloc-st Line 231  SCM_DEFINE (scm_malloc_stats, "malloc-st
231              (),              (),
232              "Return an alist ((@var{what} . @var{n}) ...) describing number\n"              "Return an alist ((@var{what} . @var{n}) ...) describing number\n"
233              "of malloced objects.\n"              "of malloced objects.\n"
234              "@var{what} is the second argument to @code{scm_must_malloc},\n"              "@var{what} is the second argument to @code{scm_gc_malloc},\n"
235              "@var{n} is the number of objects of that type currently\n"              "@var{n} is the number of objects of that type currently\n"
236              "allocated.")              "allocated.")
237  #define FUNC_NAME s_scm_malloc_stats  #define FUNC_NAME s_scm_malloc_stats

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26