debug-malloc.c 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251
  1. /* Copyright 2000-2002,2004,2006,2008-2009,2018-2019
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. #ifdef HAVE_CONFIG_H
  16. # include <config.h>
  17. #endif
  18. #include <string.h>
  19. #include <stdio.h>
  20. #include "alist.h"
  21. #include "gsubr.h"
  22. #include "numbers.h"
  23. #include "strings.h"
  24. #include "debug-malloc.h"
  25. /*
  26. * The following code is a hack which I wrote quickly in order to
  27. * solve a memory leak problem. Since I wanted to have the
  28. * application running at close to normal speed, I prioritized speed
  29. * over maintainability. /mdj
  30. */
  31. typedef struct hash_entry {
  32. const void *key;
  33. const void *data;
  34. } hash_entry_t;
  35. #define N_SEEK 8
  36. static int malloc_type_size = 31;
  37. static hash_entry_t *malloc_type = 0;
  38. static int malloc_object_size = 8191;
  39. static hash_entry_t *malloc_object = 0;
  40. #define TABLE(table) malloc_ ## table
  41. #define SIZE(table) malloc_ ## table ## _size
  42. #define HASH(table, key) \
  43. &TABLE (table)[((unsigned long) key >> 4UL) * 2654435761UL % SIZE (table)]
  44. #define CREATE_HASH_ENTRY_AT(entry, table, h, k, done) \
  45. { \
  46. int i; \
  47. do \
  48. { \
  49. for (i = 0; i < N_SEEK; ++i) \
  50. if (h[i].key == 0) \
  51. goto done; \
  52. grow (&TABLE (table), &SIZE (table)); \
  53. h = HASH (table, k); \
  54. } \
  55. while (1); \
  56. done: \
  57. (entry) = &h[i]; \
  58. }
  59. #define CREATE_HASH_ENTRY(table, k, d, done) \
  60. do \
  61. { \
  62. hash_entry_t *h = HASH (table, k); \
  63. hash_entry_t *entry; \
  64. CREATE_HASH_ENTRY_AT (entry, table, h, k, done); \
  65. entry->key = (k); \
  66. entry->data = (d); \
  67. } \
  68. while (0)
  69. #define GET_CREATE_HASH_ENTRY(entry, table, k, done) \
  70. do \
  71. { \
  72. hash_entry_t *h = HASH (table, k); \
  73. int i; \
  74. for (i = 0; i < N_SEEK; ++i) \
  75. if (h[i].key == (void *) (k)) \
  76. goto done; \
  77. CREATE_HASH_ENTRY_AT (entry, table, h, k, gche ## done); \
  78. entry->key = (k); \
  79. entry->data = 0; \
  80. break; \
  81. done: \
  82. (entry) = &h[i]; \
  83. } \
  84. while (0)
  85. static void
  86. grow (hash_entry_t **table, int *size)
  87. {
  88. hash_entry_t *oldtable = *table;
  89. int oldsize = *size + N_SEEK;
  90. hash_entry_t *TABLE (new) = 0;
  91. int SIZE (new);
  92. int i, j;
  93. SIZE (new) = 2 * (oldsize - N_SEEK + 1) - 1;
  94. again:
  95. TABLE (new) = realloc (TABLE (new),
  96. sizeof (hash_entry_t) * (SIZE (new) + N_SEEK));
  97. memset (TABLE (new), 0, sizeof (hash_entry_t) * (SIZE (new) + N_SEEK));
  98. for (i = 0; i < oldsize; ++i)
  99. if (oldtable[i].key)
  100. {
  101. hash_entry_t *h = HASH (new, oldtable[i].key);
  102. for (j = 0; j < N_SEEK; ++j)
  103. if (h[j].key == 0)
  104. {
  105. h[j] = oldtable[i];
  106. goto next;
  107. }
  108. SIZE (new) *= 2;
  109. goto again;
  110. next:
  111. ;
  112. }
  113. if (table == &malloc_type)
  114. {
  115. /* relocate malloc_object entries */
  116. for (i = 0; i < oldsize; ++i)
  117. if (oldtable[i].key)
  118. {
  119. hash_entry_t *h = HASH (new, oldtable[i].key);
  120. while (h->key != oldtable[i].key)
  121. ++h;
  122. oldtable[i].data = h;
  123. }
  124. for (i = 0; i < malloc_object_size + N_SEEK; ++i)
  125. if (malloc_object[i].key)
  126. malloc_object[i].data
  127. = ((hash_entry_t *) malloc_object[i].data)->data;
  128. }
  129. free (*table);
  130. *table = TABLE (new);
  131. *size = SIZE (new);
  132. }
  133. void
  134. scm_malloc_register (void *obj, const char *what)
  135. {
  136. hash_entry_t *type;
  137. GET_CREATE_HASH_ENTRY (type, type, what, l1);
  138. type->data = (void *) ((int) type->data + 1);
  139. CREATE_HASH_ENTRY (object, obj, type, l2);
  140. }
  141. void
  142. scm_malloc_unregister (void *obj)
  143. {
  144. hash_entry_t *object, *type;
  145. GET_CREATE_HASH_ENTRY (object, object, obj, l1);
  146. type = (hash_entry_t *) object->data;
  147. if (type == 0)
  148. {
  149. fprintf (stderr,
  150. "scm_gc_free called on object not allocated with scm_gc_malloc\n");
  151. abort ();
  152. }
  153. type->data = (void *) ((int) type->data - 1);
  154. object->key = 0;
  155. }
  156. void
  157. scm_malloc_reregister (void *old, void *new, const char *newwhat)
  158. {
  159. hash_entry_t *object, *type;
  160. if (old == NULL)
  161. scm_malloc_register (new, newwhat);
  162. else
  163. {
  164. GET_CREATE_HASH_ENTRY (object, object, old, l1);
  165. type = (hash_entry_t *) object->data;
  166. if (type == 0)
  167. {
  168. fprintf (stderr,
  169. "scm_gc_realloc called on object not allocated "
  170. "with scm_gc_malloc\n");
  171. abort ();
  172. }
  173. if (strcmp ((char *) type->key, newwhat) != 0)
  174. {
  175. if (strcmp (newwhat, "vector-set-length!") != 0)
  176. {
  177. fprintf (stderr,
  178. "scm_gc_realloc called with arg %s, was %s\n",
  179. newwhat,
  180. (char *) type->key);
  181. abort ();
  182. }
  183. }
  184. if (new != old)
  185. {
  186. object->key = 0;
  187. CREATE_HASH_ENTRY (object, new, type, l2);
  188. }
  189. }
  190. }
  191. SCM_DEFINE (scm_malloc_stats, "malloc-stats", 0, 0, 0,
  192. (),
  193. "Return an alist ((@var{what} . @var{n}) ...) describing number\n"
  194. "of malloced objects.\n"
  195. "@var{what} is the second argument to @code{scm_gc_malloc},\n"
  196. "@var{n} is the number of objects of that type currently\n"
  197. "allocated.")
  198. #define FUNC_NAME s_scm_malloc_stats
  199. {
  200. SCM res = SCM_EOL;
  201. int i;
  202. for (i = 0; i < malloc_type_size + N_SEEK; ++i)
  203. if (malloc_type[i].key)
  204. res = scm_acons (scm_from_utf8_string ((char *) malloc_type[i].key),
  205. scm_from_int ((int) malloc_type[i].data),
  206. res);
  207. return res;
  208. }
  209. #undef FUNC_NAME
  210. void
  211. scm_debug_malloc_prehistory ()
  212. {
  213. malloc_type = malloc (sizeof (hash_entry_t)
  214. * (malloc_type_size + N_SEEK));
  215. memset (malloc_type, 0, sizeof (hash_entry_t) * (malloc_type_size + N_SEEK));
  216. malloc_object = malloc (sizeof (hash_entry_t)
  217. * (malloc_object_size + N_SEEK));
  218. memset (malloc_object, 0, sizeof (hash_entry_t) * (malloc_object_size + N_SEEK));
  219. }
  220. void
  221. scm_init_debug_malloc ()
  222. {
  223. #include "debug-malloc.x"
  224. }