![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclckall.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tcl|
Return to tclckall.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tcl |
1.1 root 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:
31: struct 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:
41: static 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:
47: static int total_mallocs = 0;
48: static int total_frees = 0;
49: static int current_bytes_malloced = 0;
50: static int maximum_bytes_malloced = 0;
51: static int current_malloc_packets = 0;
52: static int maximum_malloc_packets = 0;
53: static int break_on_malloc = 0;
54: static int trace_on_at_malloc = 0;
55: static int alloc_tracing = FALSE;
56: static 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:
64: /*
65: *----------------------------------------------------------------------
66: *
67: * dump_memory_info --
68: * Display the global memory management statistics.
69: *
70: *----------------------------------------------------------------------
71: */
72: static void
73: dump_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:
90: /*
91: *----------------------------------------------------------------------
92: *
93: * ValidateMemory --
94: * Procedure to validate allocted memory guard zones.
95: *
96: *----------------------------------------------------------------------
97: */
98: static void
99: ValidateMemory (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:
153: /*
154: *----------------------------------------------------------------------
155: *
156: * Tcl_ValidateAllMemory --
157: * Validates guard regions for all allocated memory.
158: *
159: *----------------------------------------------------------------------
160: */
161: void
162: Tcl_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:
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: */
184: int
185: Tcl_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:
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: */
228: char *
229: Tcl_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:
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:
318: int
319: Tcl_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:
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 */
375: static int
376: MemoryCmd (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:
449: argError:
450: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
451: " ", argv[1], "count\"", (char *) NULL);
452: return TCL_ERROR;
453:
454: bad_suboption:
455: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
456: " ", argv[1], " on|off\"", (char *) NULL);
457: return TCL_ERROR;
458: }
459:
460: /*
461: *----------------------------------------------------------------------
462: *
463: * Tcl_InitMemory --
464: * Initialize the memory command.
465: *
466: *----------------------------------------------------------------------
467: */
468: void
469: Tcl_InitMemory(interp)
470: Tcl_Interp *interp;
471: {
472: Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData)NULL,
473: (void (*)())NULL);
474: }
475:
476: #else
477:
478:
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: */
488: VOID *
489: Tcl_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:
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: */
510: void
511: Tcl_Ckfree (ptr)
512: VOID *ptr;
513: {
514: free (ptr);
515: }
516:
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 */
527: void
528: Tcl_InitMemory(interp)
529: Tcl_Interp *interp;
530: {
531: }
532:
533: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.