tclCkalloc.c Go to the documentation of this file. /* * tclCkalloc.c -- * * Interface to malloc and free that provides support for debugging * problems involving overwritten, double freeing memory and loss of * memory. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * This code contributed by Karl Lehenbauer and Mark Diekhans * * RCS: @(#) $Id: tclCkalloc.c,v 1.32 2007/04/23 20:33:56 das Exp $ */ #include "tclInt.h" #define FALSE 0 #define TRUE 1 #ifdef TCL_MEM_DEBUG /* * One of the following structures is allocated each time the * "memory tag" command is invoked, to hold the current tag. */ typedef struct MemTag { int refCount; /* Number of mem_headers referencing this * tag. */ char string[4]; /* Actual size of string will be as large as * needed for actual tag. This must be the * last field in the structure. */ } MemTag; #define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3) static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set * by "memory tag" command). */ /* * One of the following structures is allocated just before each dynamically * allocated chunk of memory, both to record information about the chunk and * to help detect chunk under-runs. */ #define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8) struct mem_header { struct mem_header *flink; struct mem_header *blink; MemTag *tagPtr; /* Tag from "memory tag" command; may be * NULL. */ CONST char *file; long length; int line; unsigned char low_guard[LOW_GUARD_SIZE]; /* Aligns body on 8-byte boundary, plus * provides at least 8 additional guard bytes * to detect underruns. */ char body[1]; /* First byte of client's space. Actual size * of this field will be larger than one. */ }; static struct mem_header *allocHead = NULL; /* List of allocated structures */ #define GUARD_VALUE 0141 /* * The following macro determines the amount of guard space *above* each chunk * of memory. */ #define HIGH_GUARD_SIZE 8 /* * The following macro computes the offset of the "body" field within * mem_header. It is used to get back to the header pointer from the body * pointer that's used by clients. */ #define BODY_OFFSET \ ((unsigned long) (&((struct mem_header *) 0)->body)) static int total_mallocs = 0; static int total_frees = 0; static int current_bytes_malloced = 0; static int maximum_bytes_malloced = 0; static int current_malloc_packets = 0; static int maximum_malloc_packets = 0; static int break_on_malloc = 0; static int trace_on_at_malloc = 0; static int alloc_tracing = FALSE; static int init_malloced_bodies = TRUE; #ifdef MEM_VALIDATE static int validate_memory = TRUE; #else static int validate_memory = FALSE; #endif /* * The following variable indicates to TclFinalizeMemorySubsystem() that it * should dump out the state of memory before exiting. If the value is * non-NULL, it gives the name of the file in which to dump memory usage * information. */ char *tclMemDumpFileName = NULL; static char *onExitMemDumpFileName = NULL; static char dumpFile[100]; /* Records where to dump memory allocation * information. */ /* * Mutex to serialize allocations. This is a low-level mutex that must be * explicitly initialized. This is necessary because the self initializing * mutexes use ckalloc... */ static Tcl_Mutex *ckallocMutexPtr; static int ckallocInit = 0; /* * Prototypes for procedures defined in this file: */ static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp, int argc, CONST char *argv[]); static int MemoryCmd(ClientData clientData, Tcl_Interp *interp, int argc, CONST char *argv[]); static void ValidateMemory(struct mem_header *memHeaderP, CONST char *file, int line, int nukeGuards);  /* *---------------------------------------------------------------------- * * TclInitDbCkalloc -- * * Initialize the locks used by the allocator. This is only appropriate * to call in a single threaded environment, such as during * TclInitSubsystems. * *---------------------------------------------------------------------- */ void TclInitDbCkalloc(void) { if (!ckallocInit) { ckallocInit = 1; ckallocMutexPtr = Tcl_GetAllocMutex(); } }  /* *---------------------------------------------------------------------- * * TclDumpMemoryInfo -- * * Display the global memory management statistics. * *---------------------------------------------------------------------- */ void TclDumpMemoryInfo( FILE *outFile) { fprintf(outFile,"total mallocs %10d\n", total_mallocs); fprintf(outFile,"total frees %10d\n", total_frees); fprintf(outFile,"current packets allocated %10d\n", current_malloc_packets); fprintf(outFile,"current bytes allocated %10d\n", current_bytes_malloced); fprintf(outFile,"maximum packets allocated %10d\n", maximum_malloc_packets); fprintf(outFile,"maximum bytes allocated %10d\n", maximum_bytes_malloced); }  /* *---------------------------------------------------------------------- * * ValidateMemory -- * * Validate memory guard zones for a particular chunk of allocated * memory. * * Results: * None. * * Side effects: * Prints validation information about the allocated memory to stderr. * *---------------------------------------------------------------------- */ static void ValidateMemory( struct mem_header *memHeaderP, /* Memory chunk to validate */ CONST char *file, /* File containing the call to * Tcl_ValidateAllMemory */ int line, /* Line number of call to * Tcl_ValidateAllMemory */ int nukeGuards) /* If non-zero, indicates that the memory * guards are to be reset to 0 after they have * been printed */ { unsigned char *hiPtr; size_t idx; int guard_failed = FALSE; int byte; for (idx = 0; idx < LOW_GUARD_SIZE; idx++) { byte = *(memHeaderP->low_guard + idx); if (byte != GUARD_VALUE) { guard_failed = TRUE; fflush(stdout); byte &= 0xff; fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { TclDumpMemoryInfo (stderr); fprintf(stderr, "low guard failed at %lx, %s %d\n", (long unsigned int) memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); Tcl_Panic("Memory validation failure"); } hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length; for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) { byte = *(hiPtr + idx); if (byte != GUARD_VALUE) { guard_failed = TRUE; fflush(stdout); byte &= 0xff; fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte, (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */ } } if (guard_failed) { TclDumpMemoryInfo(stderr); fprintf(stderr, "high guard failed at %lx, %s %d\n", (long unsigned int) memHeaderP->body, file, line); fflush(stderr); /* In case name pointer is bad. */ fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length, memHeaderP->file, memHeaderP->line); Tcl_Panic("Memory validation failure"); } if (nukeGuards) { memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE); memset(hiPtr, 0, HIGH_GUARD_SIZE); } }  /* *---------------------------------------------------------------------- * * Tcl_ValidateAllMemory -- * * Validate memory guard regions for all allocated memory. * * Results: * None. * * Side effects: * Displays memory validation information to stderr. * *---------------------------------------------------------------------- */ void Tcl_ValidateAllMemory( CONST char *file, /* File from which Tcl_ValidateAllMemory was * called. */ int line) /* Line number of call to * Tcl_ValidateAllMemory */ { struct mem_header *memScanP; if (!ckallocInit) { TclInitDbCkalloc(); } Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { ValidateMemory(memScanP, file, line, FALSE); } Tcl_MutexUnlock(ckallocMutexPtr); }  /* *---------------------------------------------------------------------- * * Tcl_DumpActiveMemory -- * * Displays all allocated memory to a file; if no filename is given, * information will be written to stderr. * * Results: * Return TCL_ERROR if an error accessing the file occurs, `errno' will * have the file error number left in it. * *---------------------------------------------------------------------- */ int Tcl_DumpActiveMemory( CONST char *fileName) /* Name of the file to write info to */ { FILE *fileP; struct mem_header *memScanP; char *address; if (fileName == NULL) { fileP = stderr; } else { fileP = fopen(fileName, "w"); if (fileP == NULL) { return TCL_ERROR; } } Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { address = &memScanP->body [0]; fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s", (long unsigned int) address, (long unsigned int) address + memScanP->length - 1, memScanP->length, memScanP->file, memScanP->line, (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string); (void) fputc('\n', fileP); } Tcl_MutexUnlock(ckallocMutexPtr); if (fileP != stderr) { fclose(fileP); } return TCL_OK; }  /* *---------------------------------------------------------------------- * * Tcl_DbCkalloc - debugging ckalloc * * Allocate the requested amount of space plus some extra for guard bands * at both ends of the request, plus a size, panicing if there isn't * enough space, then write in the guard bands and return the address of * the space in the middle that the user asked for. * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent * by the ckalloc macro; it uses the preprocessor autodefines __FILE__ * and __LINE__. * *---------------------------------------------------------------------- */ char * Tcl_DbCkalloc( unsigned int size, CONST char *file, int line) { struct mem_header *result; if (validate_memory) { Tcl_ValidateAllMemory(file, line); } result = (struct mem_header *) TclpAlloc((unsigned)size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); if (result == NULL) { fflush(stdout); TclDumpMemoryInfo(stderr); Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } /* * Fill in guard zones and size. Also initialize the contents of the block * with bogus bytes to detect uses of initialized data. Link into * allocated list. */ if (init_malloced_bodies) { memset(result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); } if (!ckallocInit) { TclInitDbCkalloc(); } Tcl_MutexLock(ckallocMutexPtr); result->length = size; result->tagPtr = curTagPtr; if (curTagPtr != NULL) { curTagPtr->refCount++; } result->file = file; result->line = line; result->flink = allocHead; result->blink = NULL; if (allocHead != NULL) { allocHead->blink = result; } allocHead = result; total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); fprintf(stderr, "reached malloc trace enable point (%d)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; trace_on_at_malloc = 0; } if (alloc_tracing) { fprintf(stderr,"ckalloc %lx %u %s %d\n", (long unsigned int) result->body, size, file, line); } if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); fprintf(stderr,"reached malloc break limit (%d)\n", total_mallocs); fprintf(stderr, "program will now enter C debugger\n"); (void) fflush(stderr); abort(); } current_malloc_packets++; if (current_malloc_packets > maximum_malloc_packets) { maximum_malloc_packets = current_malloc_packets; } current_bytes_malloced += size; if (current_bytes_malloced > maximum_bytes_malloced) { maximum_bytes_malloced = current_bytes_malloced; } Tcl_MutexUnlock(ckallocMutexPtr); return result->body; }  char * Tcl_AttemptDbCkalloc( unsigned int size, CONST char *file, int line) { struct mem_header *result; if (validate_memory) { Tcl_ValidateAllMemory(file, line); } result = (struct mem_header *) TclpAlloc((unsigned)size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); if (result == NULL) { fflush(stdout); TclDumpMemoryInfo(stderr); return NULL; } /* * Fill in guard zones and size. Also initialize the contents of the block * with bogus bytes to detect uses of initialized data. Link into * allocated list. */ if (init_malloced_bodies) { memset(result, GUARD_VALUE, size + sizeof(struct mem_header) + HIGH_GUARD_SIZE); } else { memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE); memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE); } if (!ckallocInit) { TclInitDbCkalloc(); } Tcl_MutexLock(ckallocMutexPtr); result->length = size; result->tagPtr = curTagPtr; if (curTagPtr != NULL) { curTagPtr->refCount++; } result->file = file; result->line = line; result->flink = allocHead; result->blink = NULL; if (allocHead != NULL) { allocHead->blink = result; } allocHead = result; total_mallocs++; if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) { (void) fflush(stdout); fprintf(stderr, "reached malloc trace enable point (%d)\n", total_mallocs); fflush(stderr); alloc_tracing = TRUE; trace_on_at_malloc = 0; } if (alloc_tracing) { fprintf(stderr,"ckalloc %lx %u %s %d\n", (long unsigned int) result->body, size, file, line); } if (break_on_malloc && (total_mallocs >= break_on_malloc)) { break_on_malloc = 0; (void) fflush(stdout); fprintf(stderr,"reached malloc break limit (%d)\n", total_mallocs); fprintf(stderr, "program will now enter C debugger\n"); (void) fflush(stderr); abort(); } current_malloc_packets++; if (current_malloc_packets > maximum_malloc_packets) { maximum_malloc_packets = current_malloc_packets; } current_bytes_malloced += size; if (current_bytes_malloced > maximum_bytes_malloced) { maximum_bytes_malloced = current_bytes_malloced; } Tcl_MutexUnlock(ckallocMutexPtr); return result->body; }  /* *---------------------------------------------------------------------- * * Tcl_DbCkfree - debugging ckfree * * Verify that the low and high guards are intact, and if so then free * the buffer else Tcl_Panic. * * The guards are erased after being checked to catch duplicate frees. * * The second and third arguments are file and line, these contain the * filename and line number corresponding to the caller. These are sent * by the ckfree macro; it uses the preprocessor autodefines __FILE__ and * __LINE__. * *---------------------------------------------------------------------- */ int Tcl_DbCkfree( char *ptr, CONST char *file, int line) { struct mem_header *memp; if (ptr == NULL) { return 0; } /* * The following cast is *very* tricky. Must convert the pointer to an * integer before doing arithmetic on it, because otherwise the arithmetic * will be done differently (and incorrectly) on word-addressed machines * such as Crays (will subtract only bytes, even though BODY_OFFSET is in * words on these machines). */ memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); if (alloc_tracing) { fprintf(stderr, "ckfree %lx %ld %s %d\n", (long unsigned int) memp->body, memp->length, file, line); } if (validate_memory) { Tcl_ValidateAllMemory(file, line); } Tcl_MutexLock(ckallocMutexPtr); ValidateMemory(memp, file, line, TRUE); if (init_malloced_bodies) { memset(ptr, GUARD_VALUE, (size_t) memp->length); } total_frees++; current_malloc_packets--; current_bytes_malloced -= memp->length; if (memp->tagPtr != NULL) { memp->tagPtr->refCount--; if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) { TclpFree((char *) memp->tagPtr); } } /* * Delink from allocated list */ if (memp->flink != NULL) { memp->flink->blink = memp->blink; } if (memp->blink != NULL) { memp->blink->flink = memp->flink; } if (allocHead == memp) { allocHead = memp->flink; } TclpFree((char *) memp); Tcl_MutexUnlock(ckallocMutexPtr); return 0; }  /* *-------------------------------------------------------------------- * * Tcl_DbCkrealloc - debugging ckrealloc * * Reallocate a chunk of memory by allocating a new one of the right * size, copying the old data to the new location, and then freeing the * old memory space, using all the memory checking features of this * package. * *-------------------------------------------------------------------- */ char * Tcl_DbCkrealloc( char *ptr, unsigned int size, CONST char *file, int line) { char *newPtr; unsigned int copySize; struct mem_header *memp; if (ptr == NULL) { return Tcl_DbCkalloc(size, file, line); } /* * See comment from Tcl_DbCkfree before you change the following line. */ memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); copySize = size; if (copySize > (unsigned int) memp->length) { copySize = memp->length; } newPtr = Tcl_DbCkalloc(size, file, line); memcpy(newPtr, ptr, (size_t) copySize); Tcl_DbCkfree(ptr, file, line); return newPtr; }  char * Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, CONST char *file, int line) { char *newPtr; unsigned int copySize; struct mem_header *memp; if (ptr == NULL) { return Tcl_AttemptDbCkalloc(size, file, line); } /* * See comment from Tcl_DbCkfree before you change the following line. */ memp = (struct mem_header *) (((unsigned long) ptr) - BODY_OFFSET); copySize = size; if (copySize > (unsigned int) memp->length) { copySize = memp->length; } newPtr = Tcl_AttemptDbCkalloc(size, file, line); if (newPtr == NULL) { return NULL; } memcpy(newPtr, ptr, (size_t) copySize); Tcl_DbCkfree(ptr, file, line); return newPtr; }  /* *---------------------------------------------------------------------- * * Tcl_Alloc, et al. -- * * These functions are defined in terms of the debugging versions when * TCL_MEM_DEBUG is set. * * Results: * Same as the debug versions. * * Side effects: * Same as the debug versions. * *---------------------------------------------------------------------- */ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc #undef Tcl_AttemptAlloc #undef Tcl_AttemptRealloc char * Tcl_Alloc( unsigned int size) { return Tcl_DbCkalloc(size, "unknown", 0); } char * Tcl_AttemptAlloc( unsigned int size) { return Tcl_AttemptDbCkalloc(size, "unknown", 0); } void Tcl_Free( char *ptr) { Tcl_DbCkfree(ptr, "unknown", 0); } char * Tcl_Realloc( char *ptr, unsigned int size) { return Tcl_DbCkrealloc(ptr, size, "unknown", 0); } char * Tcl_AttemptRealloc( char *ptr, unsigned int size) { return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0); }  /* *---------------------------------------------------------------------- * * MemoryCmd -- * * Implements the Tcl "memory" command, which provides Tcl-level control * of Tcl memory debugging information. * memory active $file * memory break_on_malloc $count * memory info * memory init on|off * memory onexit $file * memory tag $string * memory trace on|off * memory trace_on_at_malloc $count * memory validate on|off * * Results: * Standard TCL results. * *---------------------------------------------------------------------- */ /* ARGSUSED */ static int MemoryCmd( ClientData clientData, Tcl_Interp *interp, int argc, CONST char *argv[]) { CONST char *fileName; Tcl_DString buffer; int result; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option [args..]\"", NULL); return TCL_ERROR; } if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " file\"", NULL); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } result = Tcl_DumpActiveMemory (fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { Tcl_AppendResult(interp, "error accessing ", argv[2], NULL); return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"break_on_malloc") == 0) { if (argc != 3) { goto argError; } if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"info") == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, "current bytes allocated", current_bytes_malloced, "maximum packets allocated", maximum_malloc_packets, "maximum bytes allocated", maximum_bytes_malloced)); return TCL_OK; } if (strcmp(argv[1],"init") == 0) { if (argc != 3) { goto bad_suboption; } init_malloced_bodies = (strcmp(argv[2],"on") == 0); return TCL_OK; } if (strcmp(argv[1],"onexit") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " onexit file\"", NULL); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } onExitMemDumpFileName = dumpFile; strcpy(onExitMemDumpFileName,fileName); Tcl_DStringFree(&buffer); return TCL_OK; } if (strcmp(argv[1],"tag") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " tag string\"", NULL); return TCL_ERROR; } if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { TclpFree((char *) curTagPtr); } curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2]))); curTagPtr->refCount = 0; strcpy(curTagPtr->string, argv[2]); return TCL_OK; } if (strcmp(argv[1],"trace") == 0) { if (argc != 3) { goto bad_suboption; } alloc_tracing = (strcmp(argv[2],"on") == 0); return TCL_OK; } if (strcmp(argv[1],"trace_on_at_malloc") == 0) { if (argc != 3) { goto argError; } if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } if (strcmp(argv[1],"validate") == 0) { if (argc != 3) { goto bad_suboption; } validate_memory = (strcmp(argv[2],"on") == 0); return TCL_OK; } Tcl_AppendResult(interp, "bad option \"", argv[1], "\": should be active, break_on_malloc, info, init, onexit, " "tag, trace, trace_on_at_malloc, or validate", NULL); return TCL_ERROR; argError: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " count\"", NULL); return TCL_ERROR; bad_suboption: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " on|off\"", NULL); return TCL_ERROR; }  /* *---------------------------------------------------------------------- * * CheckmemCmd -- * * This is the command procedure for the "checkmem" command, which causes * the application to exit after printing information about memory usage * to the file passed to this command as its first argument. * * Results: * Returns a standard Tcl completion code. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int CheckmemCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter for evaluation. */ int argc, /* Number of arguments. */ CONST char *argv[]) /* String values of arguments. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " fileName\"", NULL); return TCL_ERROR; } tclMemDumpFileName = dumpFile; strcpy(tclMemDumpFileName, argv[1]); return TCL_OK; }  /* *---------------------------------------------------------------------- * * Tcl_InitMemory -- * * Create the "memory" and "checkmem" commands in the given interpreter. * * Results: * None. * * Side effects: * New commands are added to the interpreter. * *---------------------------------------------------------------------- */ void Tcl_InitMemory( Tcl_Interp *interp) /* Interpreter in which commands should be * added */ { TclInitDbCkalloc(); Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL); } #else /* TCL_MEM_DEBUG */ /* This is the !TCL_MEM_DEBUG case */ #undef Tcl_InitMemory #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory  /* *---------------------------------------------------------------------- * * Tcl_Alloc -- * * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check * that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_Alloc( unsigned int size) { char *result; result = TclpAlloc(size); /* * Most systems will not alloc(0), instead bumping it to one so that NULL * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning * NULL, so we have to check that the NULL we get is not in response to * alloc(0). * * The ANSI spec actually says that systems either return NULL *or* a * special pointer on failure, but we only check for NULL */ if ((result == NULL) && size) { Tcl_Panic("unable to alloc %u bytes", size); } return result; } char * Tcl_DbCkalloc( unsigned int size, CONST char *file, int line) { char *result; result = (char *) TclpAlloc(size); if ((result == NULL) && size) { fflush(stdout); Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line); } return result; }  /* *---------------------------------------------------------------------- * * Tcl_AttemptAlloc -- * * Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not * check that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_AttemptAlloc( unsigned int size) { char *result; result = TclpAlloc(size); return result; } char * Tcl_AttemptDbCkalloc( unsigned int size, CONST char *file, int line) { char *result; result = (char *) TclpAlloc(size); return result; }  /* *---------------------------------------------------------------------- * * Tcl_Realloc -- * * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check * that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_Realloc( char *ptr, unsigned int size) { char *result; result = TclpRealloc(ptr, size); if ((result == NULL) && size) { Tcl_Panic("unable to realloc %u bytes", size); } return result; } char * Tcl_DbCkrealloc( char *ptr, unsigned int size, CONST char *file, int line) { char *result; result = (char *) TclpRealloc(ptr, size); if ((result == NULL) && size) { fflush(stdout); Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line); } return result; }  /* *---------------------------------------------------------------------- * * Tcl_AttemptRealloc -- * * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not * check that memory was actually allocated. * *---------------------------------------------------------------------- */ char * Tcl_AttemptRealloc( char *ptr, unsigned int size) { char *result; result = TclpRealloc(ptr, size); return result; } char * Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, CONST char *file, int line) { char *result; result = (char *) TclpRealloc(ptr, size); return result; }  /* *---------------------------------------------------------------------- * * Tcl_Free -- * * Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here rather * in the macro to keep some modules from being compiled with * TCL_MEM_DEBUG enabled and some with it disabled. * *---------------------------------------------------------------------- */ void Tcl_Free( char *ptr) { TclpFree(ptr); } int Tcl_DbCkfree( char *ptr, CONST char *file, int line) { TclpFree(ptr); return 0; }  /* *---------------------------------------------------------------------- * * Tcl_InitMemory -- * * Dummy initialization for memory command, which is only available if * TCL_MEM_DEBUG is on. * *---------------------------------------------------------------------- */ /* ARGSUSED */ void Tcl_InitMemory( Tcl_Interp *interp) { } int Tcl_DumpActiveMemory( CONST char *fileName) { return TCL_OK; } void Tcl_ValidateAllMemory( CONST char *file, int line) { } void TclDumpMemoryInfo( FILE *outFile) { } #endif /* TCL_MEM_DEBUG */  /* *--------------------------------------------------------------------------- * * TclFinalizeMemorySubsystem -- * * This procedure is called to finalize all the structures that are used * by the memory allocator on a per-process basis. * * Results: * None. * * Side effects: * This subsystem is self-initializing, since memory can be allocated * before Tcl is formally initialized. After this call, this subsystem * has been reset to its initial state and is usable again. * *--------------------------------------------------------------------------- */ void TclFinalizeMemorySubsystem(void) { #ifdef TCL_MEM_DEBUG if (tclMemDumpFileName != NULL) { Tcl_DumpActiveMemory(tclMemDumpFileName); } else if (onExitMemDumpFileName != NULL) { Tcl_DumpActiveMemory(onExitMemDumpFileName); } Tcl_MutexLock(ckallocMutexPtr); if (curTagPtr != NULL) { TclpFree((char *) curTagPtr); curTagPtr = NULL; } allocHead = NULL; Tcl_MutexUnlock(ckallocMutexPtr); #endif #if USE_TCLALLOC TclFinalizeAllocSubsystem(); #endif }  /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */

• ソフトウェア開発
• ホームページ制作
• Doxygen版
• STLport版