]> git.zerfleddert.de Git - micropolis/blame - src/tcl/tclckall.c
add ugly sdl_helper to automagically find and enable SDL_mixer
[micropolis] / src / tcl / tclckall.c
CommitLineData
6a5fa4e0
MG
1/*
2 * tclCkalloc.c --
3 * Interface to malloc and free that provides support for debugging problems
4 * involving overwritten, double freeing memory and loss of memory.
5 *
6 * Copyright 1991 Regents of the University of California
7 * Permission to use, copy, modify, and distribute this
8 * software and its documentation for any purpose and without
9 * fee is hereby granted, provided that the above copyright
10 * notice appear in all copies. The University of California
11 * makes no representations about the suitability of this
12 * software for any purpose. It is provided "as is" without
13 * express or implied warranty.
14 *
15 * This code contributed by Karl Lehenbauer and Mark Diekhans
16 *
17 */
18
19#include "tclint.h"
20
21#define FALSE 0
22#define TRUE 1
23
24#ifdef TCL_MEM_DEBUG
25#ifndef TCL_GENERIC_ONLY
26#include "tclunix.h"
27#endif
28
29#define GUARD_SIZE 8
30
31struct mem_header {
32 long length;
33 char *file;
34 int line;
35 struct mem_header *flink;
36 struct mem_header *blink;
37 unsigned char low_guard[GUARD_SIZE];
38 char body[1];
39};
40
41static struct mem_header *allocHead = NULL; /* List of allocated structures */
42
43#define GUARD_VALUE 0341
44
45/* static char high_guard[] = {0x89, 0xab, 0xcd, 0xef}; */
46
47static int total_mallocs = 0;
48static int total_frees = 0;
49static int current_bytes_malloced = 0;
50static int maximum_bytes_malloced = 0;
51static int current_malloc_packets = 0;
52static int maximum_malloc_packets = 0;
53static int break_on_malloc = 0;
54static int trace_on_at_malloc = 0;
55static int alloc_tracing = FALSE;
56static int init_malloced_bodies = FALSE;
57#ifdef MEM_VALIDATE
58 static int validate_memory = TRUE;
59#else
60 static int validate_memory = FALSE;
61#endif
62
63\f
64/*
65 *----------------------------------------------------------------------
66 *
67 * dump_memory_info --
68 * Display the global memory management statistics.
69 *
70 *----------------------------------------------------------------------
71 */
72static void
73dump_memory_info(outFile)
74 FILE *outFile;
75{
76 fprintf(outFile,"total mallocs %10d\n",
77 total_mallocs);
78 fprintf(outFile,"total frees %10d\n",
79 total_frees);
80 fprintf(outFile,"current packets allocated %10d\n",
81 current_malloc_packets);
82 fprintf(outFile,"current bytes allocated %10d\n",
83 current_bytes_malloced);
84 fprintf(outFile,"maximum packets allocated %10d\n",
85 maximum_malloc_packets);
86 fprintf(outFile,"maximum bytes allocated %10d\n",
87 maximum_bytes_malloced);
88}
89\f
90/*
91 *----------------------------------------------------------------------
92 *
93 * ValidateMemory --
94 * Procedure to validate allocted memory guard zones.
95 *
96 *----------------------------------------------------------------------
97 */
98static void
99ValidateMemory (memHeaderP, file, line, nukeGuards)
100 struct mem_header *memHeaderP;
101 char *file;
102 int line;
103 int nukeGuards;
104{
105 unsigned char *hiPtr;
106 int idx;
107 int guard_failed = FALSE;
108
109 for (idx = 0; idx < GUARD_SIZE; idx++)
110 if (*(memHeaderP->low_guard + idx) != GUARD_VALUE) {
111 guard_failed = TRUE;
112 fflush (stdout);
113 fprintf(stderr, "low guard byte %d is 0x%x\n", idx,
114 *(memHeaderP->low_guard + idx) & 0xff);
115 }
116
117 if (guard_failed) {
118 dump_memory_info (stderr);
119 fprintf (stderr, "low guard failed at %lx, %s %d\n",
120 memHeaderP->body, file, line);
121 fflush (stderr); /* In case name pointer is bad. */
122 fprintf (stderr, "Allocated at (%s %d)\n", memHeaderP->file,
123 memHeaderP->line);
124 panic ("Memory validation failure");
125 }
126
127 hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
128 for (idx = 0; idx < GUARD_SIZE; idx++)
129 if (*(hiPtr + idx) != GUARD_VALUE) {
130 guard_failed = TRUE;
131 fflush (stdout);
132 fprintf(stderr, "hi guard byte %d is 0x%x\n", idx,
133 *(hiPtr+idx) & 0xff);
134 }
135
136 if (guard_failed) {
137 dump_memory_info (stderr);
138 fprintf (stderr, "high guard failed at %lx, %s %d\n",
139 memHeaderP->body, file, line);
140 fflush (stderr); /* In case name pointer is bad. */
141 fprintf (stderr, "Allocated at (%s %d)\n", memHeaderP->file,
142 memHeaderP->line);
143 panic ("Memory validation failure");
144 }
145
146 if (nukeGuards) {
147 memset ((char *) memHeaderP->low_guard, 0, GUARD_SIZE);
148 memset ((char *) hiPtr, 0, GUARD_SIZE);
149 }
150
151}
152\f
153/*
154 *----------------------------------------------------------------------
155 *
156 * Tcl_ValidateAllMemory --
157 * Validates guard regions for all allocated memory.
158 *
159 *----------------------------------------------------------------------
160 */
161void
162Tcl_ValidateAllMemory (file, line)
163 char *file;
164 int line;
165{
166 struct mem_header *memScanP;
167
168 for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
169 ValidateMemory (memScanP, file, line, FALSE);
170
171}
172\f
173/*
174 *----------------------------------------------------------------------
175 *
176 * Tcl_DumpActiveMemory --
177 * Displays all allocated memory to stderr.
178 *
179 * Results:
180 * Return TCL_ERROR if an error accessing the file occures, `errno'
181 * will have the file error number left in it.
182 *----------------------------------------------------------------------
183 */
184int
185Tcl_DumpActiveMemory (fileName)
186 char *fileName;
187{
188 FILE *fileP;
189 struct mem_header *memScanP;
190 char *address;
191
192#ifdef MSDOS
193 fileP = fopen (fileName, "wb");
194#else
195 fileP = fopen (fileName, "w");
196#endif
197 if (fileP == NULL)
198 return TCL_ERROR;
199
200 for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
201 address = &memScanP->body [0];
202 fprintf (fileP, "%8lx - %8lx %7d @ %s %d\n", address,
203 address + memScanP->length - 1, memScanP->length,
204 memScanP->file, memScanP->line);
205 }
206 fclose (fileP);
207 return TCL_OK;
208}
209\f
210/*
211 *----------------------------------------------------------------------
212 *
213 * Tcl_DbCkalloc - debugging ckalloc
214 *
215 * Allocate the requested amount of space plus some extra for
216 * guard bands at both ends of the request, plus a size, panicing
217 * if there isn't enough space, then write in the guard bands
218 * and return the address of the space in the middle that the
219 * user asked for.
220 *
221 * The second and third arguments are file and line, these contain
222 * the filename and line number corresponding to the caller.
223 * These are sent by the ckalloc macro; it uses the preprocessor
224 * autodefines __FILE__ and __LINE__.
225 *
226 *----------------------------------------------------------------------
227 */
228char *
229Tcl_DbCkalloc(size, file, line)
230 unsigned int size;
231 char *file;
232 int line;
233{
234 struct mem_header *result;
235
236 if (validate_memory)
237 Tcl_ValidateAllMemory (file, line);
238
239 result = (struct mem_header *)malloc((unsigned)size +
240 sizeof(struct mem_header) + GUARD_SIZE);
241 if (result == NULL) {
242 fflush(stdout);
243 dump_memory_info(stderr);
244 panic("unable to alloc %d bytes, %s line %d", size, file,
245 line);
246 }
247
248 /*
249 * Fill in guard zones and size. Link into allocated list.
250 */
251 result->length = size;
252 result->file = file;
253 result->line = line;
254 memset ((char *) result->low_guard, GUARD_VALUE, GUARD_SIZE);
255 memset (result->body + size, GUARD_VALUE, GUARD_SIZE);
256 result->flink = allocHead;
257 result->blink = NULL;
258 if (allocHead != NULL)
259 allocHead->blink = result;
260 allocHead = result;
261
262 total_mallocs++;
263 if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
264 (void) fflush(stdout);
265 fprintf(stderr, "reached malloc trace enable point (%d)\n",
266 total_mallocs);
267 fflush(stderr);
268 alloc_tracing = TRUE;
269 trace_on_at_malloc = 0;
270 }
271
272 if (alloc_tracing)
273 fprintf(stderr,"ckalloc %lx %d %s %d\n", result->body, size,
274 file, line);
275
276 if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
277 break_on_malloc = 0;
278 (void) fflush(stdout);
279 fprintf(stderr,"reached malloc break limit (%d)\n",
280 total_mallocs);
281 fprintf(stderr, "program will now enter C debugger\n");
282 (void) fflush(stderr);
283 kill (getpid(), SIGINT);
284 }
285
286 current_malloc_packets++;
287 if (current_malloc_packets > maximum_malloc_packets)
288 maximum_malloc_packets = current_malloc_packets;
289 current_bytes_malloced += size;
290 if (current_bytes_malloced > maximum_bytes_malloced)
291 maximum_bytes_malloced = current_bytes_malloced;
292
293 if (init_malloced_bodies)
294 memset (result->body, 0xff, (int) size);
295
296 return result->body;
297}
298\f
299/*
300 *----------------------------------------------------------------------
301 *
302 * Tcl_DbCkfree - debugging ckfree
303 *
304 * Verify that the low and high guards are intact, and if so
305 * then free the buffer else panic.
306 *
307 * The guards are erased after being checked to catch duplicate
308 * frees.
309 *
310 * The second and third arguments are file and line, these contain
311 * the filename and line number corresponding to the caller.
312 * These are sent by the ckfree macro; it uses the preprocessor
313 * autodefines __FILE__ and __LINE__.
314 *
315 *----------------------------------------------------------------------
316 */
317
318int
319Tcl_DbCkfree(ptr, file, line)
320 char * ptr;
321 char *file;
322 int line;
323{
324 struct mem_header *memp = 0; /* Must be zero for size calc */
325
326 /*
327 * Since header ptr is zero, body offset will be size
328 */
329 memp = (struct mem_header *)(((char *) ptr) - (int)memp->body);
330
331 if (alloc_tracing)
332 fprintf(stderr, "ckfree %lx %ld %s %d\n", memp->body,
333 memp->length, file, line);
334
335 if (validate_memory)
336 Tcl_ValidateAllMemory (file, line);
337
338 ValidateMemory (memp, file, line, TRUE);
339
340 total_frees++;
341 current_malloc_packets--;
342 current_bytes_malloced -= memp->length;
343
344 /*
345 * Delink from allocated list
346 */
347 if (memp->flink != NULL)
348 memp->flink->blink = memp->blink;
349 if (memp->blink != NULL)
350 memp->blink->flink = memp->flink;
351 if (allocHead == memp)
352 allocHead = memp->flink;
353 free((char *) memp);
354 return 0;
355}
356\f
357/*
358 *----------------------------------------------------------------------
359 *
360 * MemoryCmd --
361 * Implements the TCL memory command:
362 * memory info
363 * memory display
364 * break_on_malloc count
365 * trace_on_at_malloc count
366 * trace on|off
367 * validate on|off
368 *
369 * Results:
370 * Standard TCL results.
371 *
372 *----------------------------------------------------------------------
373 */
374 /* ARGSUSED */
375static int
376MemoryCmd (clientData, interp, argc, argv)
377 char *clientData;
378 Tcl_Interp *interp;
379 int argc;
380 char **argv;
381{
382 char *fileName;
383
384 if (argc < 2) {
385 Tcl_AppendResult(interp, "wrong # args: should be \"",
386 argv[0], " option [args..]\"", (char *) NULL);
387 return TCL_ERROR;
388 }
389
390 if (strcmp(argv[1],"trace") == 0) {
391 if (argc != 3)
392 goto bad_suboption;
393 alloc_tracing = (strcmp(argv[2],"on") == 0);
394 return TCL_OK;
395 }
396 if (strcmp(argv[1],"init") == 0) {
397 if (argc != 3)
398 goto bad_suboption;
399 init_malloced_bodies = (strcmp(argv[2],"on") == 0);
400 return TCL_OK;
401 }
402 if (strcmp(argv[1],"validate") == 0) {
403 if (argc != 3)
404 goto bad_suboption;
405 validate_memory = (strcmp(argv[2],"on") == 0);
406 return TCL_OK;
407 }
408 if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
409 if (argc != 3)
410 goto argError;
411 if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK)
412 return TCL_ERROR;
413 return TCL_OK;
414 }
415 if (strcmp(argv[1],"break_on_malloc") == 0) {
416 if (argc != 3)
417 goto argError;
418 if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK)
419 return TCL_ERROR;
420 return TCL_OK;
421 }
422
423 if (strcmp(argv[1],"info") == 0) {
424 dump_memory_info(stdout);
425 return TCL_OK;
426 }
427 if (strcmp(argv[1],"active") == 0) {
428 if (argc != 3) {
429 Tcl_AppendResult(interp, "wrong # args: should be \"",
430 argv[0], " active file", (char *) NULL);
431 return TCL_ERROR;
432 }
433 fileName = argv [2];
434 if (fileName [0] == '~')
435 if ((fileName = Tcl_TildeSubst (interp, fileName)) == NULL)
436 return TCL_ERROR;
437 if (Tcl_DumpActiveMemory (fileName) != TCL_OK) {
438 Tcl_AppendResult(interp, "error accessing ", argv[2],
439 (char *) NULL);
440 return TCL_ERROR;
441 }
442 return TCL_OK;
443 }
444 Tcl_AppendResult(interp, "bad option \"", argv[1],
445 "\": should be info, init, active, break_on_malloc, ",
446 "trace_on_at_malloc, trace, or validate", (char *) NULL);
447 return TCL_ERROR;
448
449argError:
450 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
451 " ", argv[1], "count\"", (char *) NULL);
452 return TCL_ERROR;
453
454bad_suboption:
455 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
456 " ", argv[1], " on|off\"", (char *) NULL);
457 return TCL_ERROR;
458}
459\f
460/*
461 *----------------------------------------------------------------------
462 *
463 * Tcl_InitMemory --
464 * Initialize the memory command.
465 *
466 *----------------------------------------------------------------------
467 */
468void
469Tcl_InitMemory(interp)
470 Tcl_Interp *interp;
471{
472Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData)NULL,
473 (void (*)())NULL);
474}
475
476#else
477
478\f
479/*
480 *----------------------------------------------------------------------
481 *
482 * Tcl_Ckalloc --
483 * Interface to malloc when TCL_MEM_DEBUG is disabled. It does check
484 * that memory was actually allocated.
485 *
486 *----------------------------------------------------------------------
487 */
488VOID *
489Tcl_Ckalloc (size)
490 unsigned int size;
491{
492 char *result;
493
494 result = malloc(size);
495 if (result == NULL)
496 panic("unable to alloc %d bytes", size);
497 return result;
498}
499\f
500/*
501 *----------------------------------------------------------------------
502 *
503 * TckCkfree --
504 * Interface to free when TCL_MEM_DEBUG is disabled. Done here rather
505 * in the macro to keep some modules from being compiled with
506 * TCL_MEM_DEBUG enabled and some with it disabled.
507 *
508 *----------------------------------------------------------------------
509 */
510void
511Tcl_Ckfree (ptr)
512 VOID *ptr;
513{
514 free (ptr);
515}
516\f
517/*
518 *----------------------------------------------------------------------
519 *
520 * Tcl_InitMemory --
521 * Dummy initialization for memory command, which is only available
522 * if TCL_MEM_DEBUG is on.
523 *
524 *----------------------------------------------------------------------
525 */
526 /* ARGSUSED */
527void
528Tcl_InitMemory(interp)
529 Tcl_Interp *interp;
530{
531}
532
533#endif
Impressum, Datenschutz