1 | /* |
---|
2 | * tclCkalloc.c -- |
---|
3 | * |
---|
4 | * Interface to malloc and free that provides support for debugging problems |
---|
5 | * involving overwritten, double freeing memory and loss of memory. |
---|
6 | * |
---|
7 | * Copyright (c) 1991-1994 The Regents of the University of California. |
---|
8 | * Copyright (c) 1994-1996 Sun Microsystems, Inc. |
---|
9 | * |
---|
10 | * See the file "license.terms" for information on usage and redistribution |
---|
11 | * of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
12 | * |
---|
13 | * This code contributed by Karl Lehenbauer and Mark Diekhans |
---|
14 | * |
---|
15 | * RCS: @(#) $Id: tclCkalloc.c,v 1.1 2008-06-04 13:58:04 demin Exp $ |
---|
16 | */ |
---|
17 | |
---|
18 | #include "tclInt.h" |
---|
19 | #include "tclPort.h" |
---|
20 | |
---|
21 | #define FALSE 0 |
---|
22 | #define TRUE 1 |
---|
23 | |
---|
24 | #ifdef TCL_MEM_DEBUG |
---|
25 | |
---|
26 | /* |
---|
27 | * One of the following structures is allocated each time the |
---|
28 | * "memory tag" command is invoked, to hold the current tag. |
---|
29 | */ |
---|
30 | |
---|
31 | typedef struct MemTag { |
---|
32 | int refCount; /* Number of mem_headers referencing |
---|
33 | * this tag. */ |
---|
34 | char string[4]; /* Actual size of string will be as |
---|
35 | * large as needed for actual tag. This |
---|
36 | * must be the last field in the structure. */ |
---|
37 | } MemTag; |
---|
38 | |
---|
39 | #define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3) |
---|
40 | |
---|
41 | static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers |
---|
42 | * (set by "memory tag" command). */ |
---|
43 | |
---|
44 | /* |
---|
45 | * One of the following structures is allocated just before each |
---|
46 | * dynamically allocated chunk of memory, both to record information |
---|
47 | * about the chunk and to help detect chunk under-runs. |
---|
48 | */ |
---|
49 | |
---|
50 | #define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8) |
---|
51 | struct mem_header { |
---|
52 | struct mem_header *flink; |
---|
53 | struct mem_header *blink; |
---|
54 | MemTag *tagPtr; /* Tag from "memory tag" command; may be |
---|
55 | * NULL. */ |
---|
56 | char *file; |
---|
57 | long length; |
---|
58 | int line; |
---|
59 | unsigned char low_guard[LOW_GUARD_SIZE]; |
---|
60 | /* Aligns body on 8-byte boundary, plus |
---|
61 | * provides at least 8 additional guard bytes |
---|
62 | * to detect underruns. */ |
---|
63 | char body[1]; /* First byte of client's space. Actual |
---|
64 | * size of this field will be larger than |
---|
65 | * one. */ |
---|
66 | }; |
---|
67 | |
---|
68 | static struct mem_header *allocHead = NULL; /* List of allocated structures */ |
---|
69 | |
---|
70 | #define GUARD_VALUE 0141 |
---|
71 | |
---|
72 | /* |
---|
73 | * The following macro determines the amount of guard space *above* each |
---|
74 | * chunk of memory. |
---|
75 | */ |
---|
76 | |
---|
77 | #define HIGH_GUARD_SIZE 8 |
---|
78 | |
---|
79 | /* |
---|
80 | * The following macro computes the offset of the "body" field within |
---|
81 | * mem_header. It is used to get back to the header pointer from the |
---|
82 | * body pointer that's used by clients. |
---|
83 | */ |
---|
84 | |
---|
85 | #define BODY_OFFSET \ |
---|
86 | ((unsigned long) (&((struct mem_header *) 0)->body)) |
---|
87 | |
---|
88 | static int total_mallocs = 0; |
---|
89 | static int total_frees = 0; |
---|
90 | static int current_bytes_malloced = 0; |
---|
91 | static int maximum_bytes_malloced = 0; |
---|
92 | static int current_malloc_packets = 0; |
---|
93 | static int maximum_malloc_packets = 0; |
---|
94 | static int break_on_malloc = 0; |
---|
95 | static int trace_on_at_malloc = 0; |
---|
96 | static int alloc_tracing = FALSE; |
---|
97 | static int init_malloced_bodies = TRUE; |
---|
98 | #ifdef MEM_VALIDATE |
---|
99 | static int validate_memory = TRUE; |
---|
100 | #else |
---|
101 | static int validate_memory = FALSE; |
---|
102 | #endif |
---|
103 | |
---|
104 | /* |
---|
105 | * Prototypes for procedures defined in this file: |
---|
106 | */ |
---|
107 | |
---|
108 | static int MemoryCmd _ANSI_ARGS_((ClientData clientData, |
---|
109 | Tcl_Interp *interp, int argc, char **argv)); |
---|
110 | static void ValidateMemory _ANSI_ARGS_(( |
---|
111 | struct mem_header *memHeaderP, char *file, |
---|
112 | int line, int nukeGuards)); |
---|
113 | |
---|
114 | /* |
---|
115 | *---------------------------------------------------------------------- |
---|
116 | * |
---|
117 | * TclDumpMemoryInfo -- |
---|
118 | * Display the global memory management statistics. |
---|
119 | * |
---|
120 | *---------------------------------------------------------------------- |
---|
121 | */ |
---|
122 | void |
---|
123 | TclDumpMemoryInfo(outFile) |
---|
124 | FILE *outFile; |
---|
125 | { |
---|
126 | fprintf(outFile,"total mallocs %10d\n", |
---|
127 | total_mallocs); |
---|
128 | fprintf(outFile,"total frees %10d\n", |
---|
129 | total_frees); |
---|
130 | fprintf(outFile,"current packets allocated %10d\n", |
---|
131 | current_malloc_packets); |
---|
132 | fprintf(outFile,"current bytes allocated %10d\n", |
---|
133 | current_bytes_malloced); |
---|
134 | fprintf(outFile,"maximum packets allocated %10d\n", |
---|
135 | maximum_malloc_packets); |
---|
136 | fprintf(outFile,"maximum bytes allocated %10d\n", |
---|
137 | maximum_bytes_malloced); |
---|
138 | } |
---|
139 | |
---|
140 | /* |
---|
141 | *---------------------------------------------------------------------- |
---|
142 | * |
---|
143 | * ValidateMemory -- |
---|
144 | * Procedure to validate allocted memory guard zones. |
---|
145 | * |
---|
146 | *---------------------------------------------------------------------- |
---|
147 | */ |
---|
148 | static void |
---|
149 | ValidateMemory(memHeaderP, file, line, nukeGuards) |
---|
150 | struct mem_header *memHeaderP; |
---|
151 | char *file; |
---|
152 | int line; |
---|
153 | int nukeGuards; |
---|
154 | { |
---|
155 | unsigned char *hiPtr; |
---|
156 | int idx; |
---|
157 | int guard_failed = FALSE; |
---|
158 | int byte; |
---|
159 | |
---|
160 | for (idx = 0; idx < LOW_GUARD_SIZE; idx++) { |
---|
161 | byte = *(memHeaderP->low_guard + idx); |
---|
162 | if (byte != GUARD_VALUE) { |
---|
163 | guard_failed = TRUE; |
---|
164 | fflush(stdout); |
---|
165 | byte &= 0xff; |
---|
166 | fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", idx, byte, |
---|
167 | (isprint(UCHAR(byte)) ? byte : ' ')); |
---|
168 | } |
---|
169 | } |
---|
170 | if (guard_failed) { |
---|
171 | TclDumpMemoryInfo (stderr); |
---|
172 | fprintf(stderr, "low guard failed at %lx, %s %d\n", |
---|
173 | (long unsigned int) memHeaderP->body, file, line); |
---|
174 | fflush(stderr); /* In case name pointer is bad. */ |
---|
175 | fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, |
---|
176 | memHeaderP->file, memHeaderP->line); |
---|
177 | panic ("Memory validation failure"); |
---|
178 | } |
---|
179 | |
---|
180 | hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length; |
---|
181 | for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) { |
---|
182 | byte = *(hiPtr + idx); |
---|
183 | if (byte != GUARD_VALUE) { |
---|
184 | guard_failed = TRUE; |
---|
185 | fflush (stdout); |
---|
186 | byte &= 0xff; |
---|
187 | fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", idx, byte, |
---|
188 | (isprint(UCHAR(byte)) ? byte : ' ')); |
---|
189 | } |
---|
190 | } |
---|
191 | |
---|
192 | if (guard_failed) { |
---|
193 | TclDumpMemoryInfo (stderr); |
---|
194 | fprintf(stderr, "high guard failed at %lx, %s %d\n", |
---|
195 | (long unsigned int) memHeaderP->body, file, line); |
---|
196 | fflush(stderr); /* In case name pointer is bad. */ |
---|
197 | fprintf(stderr, "%ld bytes allocated at (%s %d)\n", |
---|
198 | memHeaderP->length, memHeaderP->file, |
---|
199 | memHeaderP->line); |
---|
200 | panic("Memory validation failure"); |
---|
201 | } |
---|
202 | |
---|
203 | if (nukeGuards) { |
---|
204 | memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); |
---|
205 | memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE); |
---|
206 | } |
---|
207 | |
---|
208 | } |
---|
209 | |
---|
210 | /* |
---|
211 | *---------------------------------------------------------------------- |
---|
212 | * |
---|
213 | * Tcl_ValidateAllMemory -- |
---|
214 | * Validates guard regions for all allocated memory. |
---|
215 | * |
---|
216 | *---------------------------------------------------------------------- |
---|
217 | */ |
---|
218 | void |
---|
219 | Tcl_ValidateAllMemory (file, line) |
---|
220 | char *file; |
---|
221 | int line; |
---|
222 | { |
---|
223 | struct mem_header *memScanP; |
---|
224 | |
---|
225 | for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) |
---|
226 | ValidateMemory(memScanP, file, line, FALSE); |
---|
227 | |
---|
228 | } |
---|
229 | |
---|
230 | /* |
---|
231 | *---------------------------------------------------------------------- |
---|
232 | * |
---|
233 | * Tcl_DumpActiveMemory -- |
---|
234 | * Displays all allocated memory to stderr. |
---|
235 | * |
---|
236 | * Results: |
---|
237 | * Return TCL_ERROR if an error accessing the file occures, `errno' |
---|
238 | * will have the file error number left in it. |
---|
239 | *---------------------------------------------------------------------- |
---|
240 | */ |
---|
241 | int |
---|
242 | Tcl_DumpActiveMemory (fileName) |
---|
243 | char *fileName; |
---|
244 | { |
---|
245 | FILE *fileP; |
---|
246 | struct mem_header *memScanP; |
---|
247 | char *address; |
---|
248 | |
---|
249 | fileP = fopen(fileName, "w"); |
---|
250 | if (fileP == NULL) |
---|
251 | return TCL_ERROR; |
---|
252 | |
---|
253 | for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { |
---|
254 | address = &memScanP->body [0]; |
---|
255 | fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s", |
---|
256 | (long unsigned int) address, |
---|
257 | (long unsigned int) address + memScanP->length - 1, |
---|
258 | memScanP->length, memScanP->file, memScanP->line, |
---|
259 | (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string); |
---|
260 | (void) fputc('\n', fileP); |
---|
261 | } |
---|
262 | fclose (fileP); |
---|
263 | return TCL_OK; |
---|
264 | } |
---|
265 | |
---|
266 | /* |
---|
267 | *---------------------------------------------------------------------- |
---|
268 | * |
---|
269 | * Tcl_DbCkalloc - debugging ckalloc |
---|
270 | * |
---|
271 | * Allocate the requested amount of space plus some extra for |
---|
272 | * guard bands at both ends of the request, plus a size, panicing |
---|
273 | * if there isn't enough space, then write in the guard bands |
---|
274 | * and return the address of the space in the middle that the |
---|
275 | * user asked for. |
---|
276 | * |
---|
277 | * The second and third arguments are file and line, these contain |
---|
278 | * the filename and line number corresponding to the caller. |
---|
279 | * These are sent by the ckalloc macro; it uses the preprocessor |
---|
280 | * autodefines __FILE__ and __LINE__. |
---|
281 | * |
---|
282 | *---------------------------------------------------------------------- |
---|
283 | */ |
---|
284 | char * |
---|
285 | Tcl_DbCkalloc(size, file, line) |
---|
286 | unsigned int size; |
---|
287 | char *file; |
---|
288 | int line; |
---|
289 | { |
---|
290 | struct mem_header *result; |
---|
291 | |
---|
292 | if (validate_memory) |
---|
293 | Tcl_ValidateAllMemory (file, line); |
---|
294 | |
---|
295 | result = (struct mem_header *) TclpAlloc((unsigned)size + |
---|
296 | sizeof(struct mem_header) + HIGH_GUARD_SIZE); |
---|
297 | if (result == NULL) { |
---|
298 | fflush(stdout); |
---|
299 | TclDumpMemoryInfo(stderr); |
---|
300 | panic("unable to alloc %d bytes, %s line %d", size, file, |
---|
301 | line); |
---|
302 | } |
---|
303 | |
---|
304 | /* |
---|
305 | * Fill in guard zones and size. Also initialize the contents of |
---|
306 | * the block with bogus bytes to detect uses of initialized data. |
---|
307 | * Link into allocated list. |
---|
308 | */ |
---|
309 | if (init_malloced_bodies) { |
---|
310 | memset ((VOID *) result, GUARD_VALUE, |
---|
311 | size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); |
---|
312 | } else { |
---|
313 | memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); |
---|
314 | memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); |
---|
315 | } |
---|
316 | result->length = size; |
---|
317 | result->tagPtr = curTagPtr; |
---|
318 | if (curTagPtr != NULL) { |
---|
319 | curTagPtr->refCount++; |
---|
320 | } |
---|
321 | result->file = file; |
---|
322 | result->line = line; |
---|
323 | result->flink = allocHead; |
---|
324 | result->blink = NULL; |
---|
325 | if (allocHead != NULL) |
---|
326 | allocHead->blink = result; |
---|
327 | allocHead = result; |
---|
328 | |
---|
329 | total_mallocs++; |
---|
330 | if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { |
---|
331 | (void) fflush(stdout); |
---|
332 | fprintf(stderr, "reached malloc trace enable point (%d)\n", |
---|
333 | total_mallocs); |
---|
334 | fflush(stderr); |
---|
335 | alloc_tracing = TRUE; |
---|
336 | trace_on_at_malloc = 0; |
---|
337 | } |
---|
338 | |
---|
339 | if (alloc_tracing) |
---|
340 | fprintf(stderr,"ckalloc %lx %d %s %d\n", |
---|
341 | (long unsigned int) result->body, size, file, line); |
---|
342 | |
---|
343 | if (break_on_malloc && (total_mallocs >= break_on_malloc)) { |
---|
344 | break_on_malloc = 0; |
---|
345 | (void) fflush(stdout); |
---|
346 | fprintf(stderr,"reached malloc break limit (%d)\n", |
---|
347 | total_mallocs); |
---|
348 | fprintf(stderr, "program will now enter C debugger\n"); |
---|
349 | (void) fflush(stderr); |
---|
350 | abort(); |
---|
351 | } |
---|
352 | |
---|
353 | current_malloc_packets++; |
---|
354 | if (current_malloc_packets > maximum_malloc_packets) |
---|
355 | maximum_malloc_packets = current_malloc_packets; |
---|
356 | current_bytes_malloced += size; |
---|
357 | if (current_bytes_malloced > maximum_bytes_malloced) |
---|
358 | maximum_bytes_malloced = current_bytes_malloced; |
---|
359 | |
---|
360 | return result->body; |
---|
361 | } |
---|
362 | |
---|
363 | /* |
---|
364 | *---------------------------------------------------------------------- |
---|
365 | * |
---|
366 | * Tcl_DbCkfree - debugging ckfree |
---|
367 | * |
---|
368 | * Verify that the low and high guards are intact, and if so |
---|
369 | * then free the buffer else panic. |
---|
370 | * |
---|
371 | * The guards are erased after being checked to catch duplicate |
---|
372 | * frees. |
---|
373 | * |
---|
374 | * The second and third arguments are file and line, these contain |
---|
375 | * the filename and line number corresponding to the caller. |
---|
376 | * These are sent by the ckfree macro; it uses the preprocessor |
---|
377 | * autodefines __FILE__ and __LINE__. |
---|
378 | * |
---|
379 | *---------------------------------------------------------------------- |
---|
380 | */ |
---|
381 | |
---|
382 | int |
---|
383 | Tcl_DbCkfree(ptr, file, line) |
---|
384 | char * ptr; |
---|
385 | char *file; |
---|
386 | int line; |
---|
387 | { |
---|
388 | /* |
---|
389 | * The following cast is *very* tricky. Must convert the pointer |
---|
390 | * to an integer before doing arithmetic on it, because otherwise |
---|
391 | * the arithmetic will be done differently (and incorrectly) on |
---|
392 | * word-addressed machines such as Crays (will subtract only bytes, |
---|
393 | * even though BODY_OFFSET is in words on these machines). |
---|
394 | */ |
---|
395 | |
---|
396 | struct mem_header *memp = (struct mem_header *) |
---|
397 | (((unsigned long) ptr) - BODY_OFFSET); |
---|
398 | |
---|
399 | if (alloc_tracing) |
---|
400 | fprintf(stderr, "ckfree %lx %ld %s %d\n", |
---|
401 | (long unsigned int) memp->body, memp->length, file, line); |
---|
402 | |
---|
403 | if (validate_memory) |
---|
404 | Tcl_ValidateAllMemory(file, line); |
---|
405 | |
---|
406 | ValidateMemory(memp, file, line, TRUE); |
---|
407 | if (init_malloced_bodies) { |
---|
408 | memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length); |
---|
409 | } |
---|
410 | |
---|
411 | total_frees++; |
---|
412 | current_malloc_packets--; |
---|
413 | current_bytes_malloced -= memp->length; |
---|
414 | |
---|
415 | if (memp->tagPtr != NULL) { |
---|
416 | memp->tagPtr->refCount--; |
---|
417 | if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) { |
---|
418 | TclpFree((char *) memp->tagPtr); |
---|
419 | } |
---|
420 | } |
---|
421 | |
---|
422 | /* |
---|
423 | * Delink from allocated list |
---|
424 | */ |
---|
425 | if (memp->flink != NULL) |
---|
426 | memp->flink->blink = memp->blink; |
---|
427 | if (memp->blink != NULL) |
---|
428 | memp->blink->flink = memp->flink; |
---|
429 | if (allocHead == memp) |
---|
430 | allocHead = memp->flink; |
---|
431 | TclpFree((char *) memp); |
---|
432 | return 0; |
---|
433 | } |
---|
434 | |
---|
435 | /* |
---|
436 | *-------------------------------------------------------------------- |
---|
437 | * |
---|
438 | * Tcl_DbCkrealloc - debugging ckrealloc |
---|
439 | * |
---|
440 | * Reallocate a chunk of memory by allocating a new one of the |
---|
441 | * right size, copying the old data to the new location, and then |
---|
442 | * freeing the old memory space, using all the memory checking |
---|
443 | * features of this package. |
---|
444 | * |
---|
445 | *-------------------------------------------------------------------- |
---|
446 | */ |
---|
447 | char * |
---|
448 | Tcl_DbCkrealloc(ptr, size, file, line) |
---|
449 | char *ptr; |
---|
450 | unsigned int size; |
---|
451 | char *file; |
---|
452 | int line; |
---|
453 | { |
---|
454 | char *new; |
---|
455 | unsigned int copySize; |
---|
456 | |
---|
457 | /* |
---|
458 | * See comment from Tcl_DbCkfree before you change the following |
---|
459 | * line. |
---|
460 | */ |
---|
461 | |
---|
462 | struct mem_header *memp = (struct mem_header *) |
---|
463 | (((unsigned long) ptr) - BODY_OFFSET); |
---|
464 | |
---|
465 | copySize = size; |
---|
466 | if (copySize > (unsigned int) memp->length) { |
---|
467 | copySize = memp->length; |
---|
468 | } |
---|
469 | new = Tcl_DbCkalloc(size, file, line); |
---|
470 | memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize); |
---|
471 | Tcl_DbCkfree(ptr, file, line); |
---|
472 | return(new); |
---|
473 | } |
---|
474 | |
---|
475 | |
---|
476 | /* |
---|
477 | *---------------------------------------------------------------------- |
---|
478 | * |
---|
479 | * Tcl_Alloc, et al. -- |
---|
480 | * |
---|
481 | * These functions are defined in terms of the debugging versions |
---|
482 | * when TCL_MEM_DEBUG is set. |
---|
483 | * |
---|
484 | * Results: |
---|
485 | * Same as the debug versions. |
---|
486 | * |
---|
487 | * Side effects: |
---|
488 | * Same as the debug versions. |
---|
489 | * |
---|
490 | *---------------------------------------------------------------------- |
---|
491 | */ |
---|
492 | |
---|
493 | #undef Tcl_Alloc |
---|
494 | #undef Tcl_Free |
---|
495 | #undef Tcl_Realloc |
---|
496 | |
---|
497 | char * |
---|
498 | Tcl_Alloc(size) |
---|
499 | unsigned int size; |
---|
500 | { |
---|
501 | return Tcl_DbCkalloc(size, "unknown", 0); |
---|
502 | } |
---|
503 | |
---|
504 | void |
---|
505 | Tcl_Free(ptr) |
---|
506 | char *ptr; |
---|
507 | { |
---|
508 | Tcl_DbCkfree(ptr, "unknown", 0); |
---|
509 | } |
---|
510 | |
---|
511 | char * |
---|
512 | Tcl_Realloc(ptr, size) |
---|
513 | char *ptr; |
---|
514 | unsigned int size; |
---|
515 | { |
---|
516 | return Tcl_DbCkrealloc(ptr, size, "unknown", 0); |
---|
517 | } |
---|
518 | |
---|
519 | /* |
---|
520 | *---------------------------------------------------------------------- |
---|
521 | * |
---|
522 | * MemoryCmd -- |
---|
523 | * Implements the TCL memory command: |
---|
524 | * memory info |
---|
525 | * memory display |
---|
526 | * break_on_malloc count |
---|
527 | * trace_on_at_malloc count |
---|
528 | * trace on|off |
---|
529 | * validate on|off |
---|
530 | * |
---|
531 | * Results: |
---|
532 | * Standard TCL results. |
---|
533 | * |
---|
534 | *---------------------------------------------------------------------- |
---|
535 | */ |
---|
536 | /* ARGSUSED */ |
---|
537 | static int |
---|
538 | MemoryCmd (clientData, interp, argc, argv) |
---|
539 | ClientData clientData; |
---|
540 | Tcl_Interp *interp; |
---|
541 | int argc; |
---|
542 | char **argv; |
---|
543 | { |
---|
544 | char *fileName; |
---|
545 | Tcl_DString buffer; |
---|
546 | int result; |
---|
547 | |
---|
548 | if (argc < 2) { |
---|
549 | Tcl_AppendResult(interp, "wrong # args: should be \"", |
---|
550 | argv[0], " option [args..]\"", (char *) NULL); |
---|
551 | return TCL_ERROR; |
---|
552 | } |
---|
553 | |
---|
554 | if (strcmp(argv[1],"active") == 0) { |
---|
555 | if (argc != 3) { |
---|
556 | Tcl_AppendResult(interp, "wrong # args: should be \"", |
---|
557 | argv[0], " active file\"", (char *) NULL); |
---|
558 | return TCL_ERROR; |
---|
559 | } |
---|
560 | fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); |
---|
561 | if (fileName == NULL) { |
---|
562 | return TCL_ERROR; |
---|
563 | } |
---|
564 | result = Tcl_DumpActiveMemory (fileName); |
---|
565 | Tcl_DStringFree(&buffer); |
---|
566 | if (result != TCL_OK) { |
---|
567 | Tcl_AppendResult(interp, "error accessing ", argv[2], |
---|
568 | (char *) NULL); |
---|
569 | return TCL_ERROR; |
---|
570 | } |
---|
571 | return TCL_OK; |
---|
572 | } |
---|
573 | if (strcmp(argv[1],"break_on_malloc") == 0) { |
---|
574 | if (argc != 3) { |
---|
575 | goto argError; |
---|
576 | } |
---|
577 | if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) { |
---|
578 | return TCL_ERROR; |
---|
579 | } |
---|
580 | return TCL_OK; |
---|
581 | } |
---|
582 | if (strcmp(argv[1],"info") == 0) { |
---|
583 | TclDumpMemoryInfo(stdout); |
---|
584 | return TCL_OK; |
---|
585 | } |
---|
586 | if (strcmp(argv[1],"init") == 0) { |
---|
587 | if (argc != 3) { |
---|
588 | goto bad_suboption; |
---|
589 | } |
---|
590 | init_malloced_bodies = (strcmp(argv[2],"on") == 0); |
---|
591 | return TCL_OK; |
---|
592 | } |
---|
593 | if (strcmp(argv[1],"tag") == 0) { |
---|
594 | if (argc != 3) { |
---|
595 | Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], |
---|
596 | " tag string\"", (char *) NULL); |
---|
597 | return TCL_ERROR; |
---|
598 | } |
---|
599 | if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { |
---|
600 | TclpFree((char *) curTagPtr); |
---|
601 | } |
---|
602 | curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2]))); |
---|
603 | curTagPtr->refCount = 0; |
---|
604 | strcpy(curTagPtr->string, argv[2]); |
---|
605 | return TCL_OK; |
---|
606 | } |
---|
607 | if (strcmp(argv[1],"trace") == 0) { |
---|
608 | if (argc != 3) { |
---|
609 | goto bad_suboption; |
---|
610 | } |
---|
611 | alloc_tracing = (strcmp(argv[2],"on") == 0); |
---|
612 | return TCL_OK; |
---|
613 | } |
---|
614 | |
---|
615 | if (strcmp(argv[1],"trace_on_at_malloc") == 0) { |
---|
616 | if (argc != 3) { |
---|
617 | goto argError; |
---|
618 | } |
---|
619 | if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) { |
---|
620 | return TCL_ERROR; |
---|
621 | } |
---|
622 | return TCL_OK; |
---|
623 | } |
---|
624 | if (strcmp(argv[1],"validate") == 0) { |
---|
625 | if (argc != 3) { |
---|
626 | goto bad_suboption; |
---|
627 | } |
---|
628 | validate_memory = (strcmp(argv[2],"on") == 0); |
---|
629 | return TCL_OK; |
---|
630 | } |
---|
631 | |
---|
632 | Tcl_AppendResult(interp, "bad option \"", argv[1], |
---|
633 | "\": should be active, break_on_malloc, info, init, ", |
---|
634 | "tag, trace, trace_on_at_malloc, or validate", (char *) NULL); |
---|
635 | return TCL_ERROR; |
---|
636 | |
---|
637 | argError: |
---|
638 | Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], |
---|
639 | " ", argv[1], " count\"", (char *) NULL); |
---|
640 | return TCL_ERROR; |
---|
641 | |
---|
642 | bad_suboption: |
---|
643 | Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], |
---|
644 | " ", argv[1], " on|off\"", (char *) NULL); |
---|
645 | return TCL_ERROR; |
---|
646 | } |
---|
647 | |
---|
648 | /* |
---|
649 | *---------------------------------------------------------------------- |
---|
650 | * |
---|
651 | * Tcl_InitMemory -- |
---|
652 | * Initialize the memory command. |
---|
653 | * |
---|
654 | *---------------------------------------------------------------------- |
---|
655 | */ |
---|
656 | void |
---|
657 | Tcl_InitMemory(interp) |
---|
658 | Tcl_Interp *interp; |
---|
659 | { |
---|
660 | Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL, |
---|
661 | (Tcl_CmdDeleteProc *) NULL); |
---|
662 | } |
---|
663 | |
---|
664 | #else |
---|
665 | |
---|
666 | |
---|
667 | /* |
---|
668 | *---------------------------------------------------------------------- |
---|
669 | * |
---|
670 | * Tcl_Alloc -- |
---|
671 | * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check |
---|
672 | * that memory was actually allocated. |
---|
673 | * |
---|
674 | *---------------------------------------------------------------------- |
---|
675 | */ |
---|
676 | |
---|
677 | char * |
---|
678 | Tcl_Alloc (size) |
---|
679 | unsigned int size; |
---|
680 | { |
---|
681 | char *result; |
---|
682 | |
---|
683 | result = TclpAlloc(size); |
---|
684 | if (result == NULL) |
---|
685 | panic("unable to alloc %d bytes", size); |
---|
686 | return result; |
---|
687 | } |
---|
688 | |
---|
689 | char * |
---|
690 | Tcl_DbCkalloc(size, file, line) |
---|
691 | unsigned int size; |
---|
692 | char *file; |
---|
693 | int line; |
---|
694 | { |
---|
695 | char *result; |
---|
696 | |
---|
697 | result = (char *) TclpAlloc(size); |
---|
698 | |
---|
699 | if (result == NULL) { |
---|
700 | fflush(stdout); |
---|
701 | panic("unable to alloc %d bytes, %s line %d", size, file, |
---|
702 | line); |
---|
703 | } |
---|
704 | return result; |
---|
705 | } |
---|
706 | |
---|
707 | |
---|
708 | /* |
---|
709 | *---------------------------------------------------------------------- |
---|
710 | * |
---|
711 | * Tcl_Realloc -- |
---|
712 | * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does |
---|
713 | * check that memory was actually allocated. |
---|
714 | * |
---|
715 | *---------------------------------------------------------------------- |
---|
716 | */ |
---|
717 | |
---|
718 | char * |
---|
719 | Tcl_Realloc(ptr, size) |
---|
720 | char *ptr; |
---|
721 | unsigned int size; |
---|
722 | { |
---|
723 | char *result; |
---|
724 | |
---|
725 | result = TclpRealloc(ptr, size); |
---|
726 | if (result == NULL) |
---|
727 | panic("unable to realloc %d bytes", size); |
---|
728 | return result; |
---|
729 | } |
---|
730 | |
---|
731 | char * |
---|
732 | Tcl_DbCkrealloc(ptr, size, file, line) |
---|
733 | char *ptr; |
---|
734 | unsigned int size; |
---|
735 | char *file; |
---|
736 | int line; |
---|
737 | { |
---|
738 | char *result; |
---|
739 | |
---|
740 | result = (char *) TclpRealloc(ptr, size); |
---|
741 | |
---|
742 | if (result == NULL) { |
---|
743 | fflush(stdout); |
---|
744 | panic("unable to realloc %d bytes, %s line %d", size, file, |
---|
745 | line); |
---|
746 | } |
---|
747 | return result; |
---|
748 | } |
---|
749 | |
---|
750 | /* |
---|
751 | *---------------------------------------------------------------------- |
---|
752 | * |
---|
753 | * Tcl_Free -- |
---|
754 | * Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here |
---|
755 | * rather in the macro to keep some modules from being compiled with |
---|
756 | * TCL_MEM_DEBUG enabled and some with it disabled. |
---|
757 | * |
---|
758 | *---------------------------------------------------------------------- |
---|
759 | */ |
---|
760 | |
---|
761 | void |
---|
762 | Tcl_Free (ptr) |
---|
763 | char *ptr; |
---|
764 | { |
---|
765 | TclpFree(ptr); |
---|
766 | } |
---|
767 | |
---|
768 | int |
---|
769 | Tcl_DbCkfree(ptr, file, line) |
---|
770 | char * ptr; |
---|
771 | char *file; |
---|
772 | int line; |
---|
773 | { |
---|
774 | TclpFree(ptr); |
---|
775 | return 0; |
---|
776 | } |
---|
777 | |
---|
778 | /* |
---|
779 | *---------------------------------------------------------------------- |
---|
780 | * |
---|
781 | * Tcl_InitMemory -- |
---|
782 | * Dummy initialization for memory command, which is only available |
---|
783 | * if TCL_MEM_DEBUG is on. |
---|
784 | * |
---|
785 | *---------------------------------------------------------------------- |
---|
786 | */ |
---|
787 | /* ARGSUSED */ |
---|
788 | void |
---|
789 | Tcl_InitMemory(interp) |
---|
790 | Tcl_Interp *interp; |
---|
791 | { |
---|
792 | } |
---|
793 | |
---|
794 | #undef Tcl_DumpActiveMemory |
---|
795 | #undef Tcl_ValidateAllMemory |
---|
796 | |
---|
797 | extern int Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName)); |
---|
798 | extern void Tcl_ValidateAllMemory _ANSI_ARGS_((char *file, |
---|
799 | int line)); |
---|
800 | |
---|
801 | int |
---|
802 | Tcl_DumpActiveMemory(fileName) |
---|
803 | char *fileName; |
---|
804 | { |
---|
805 | return TCL_OK; |
---|
806 | } |
---|
807 | |
---|
808 | void |
---|
809 | Tcl_ValidateAllMemory(file, line) |
---|
810 | char *file; |
---|
811 | int line; |
---|
812 | { |
---|
813 | } |
---|
814 | |
---|
815 | #endif |
---|