diff options
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r-- | generic/tclCkalloc.c | 161 |
1 files changed, 83 insertions, 78 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 5c0432d..ab977cb 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -20,6 +20,12 @@ #define FALSE 0 #define TRUE 1 +#undef Tcl_Alloc +#undef Tcl_Free +#undef Tcl_Realloc +#undef Tcl_AttemptAlloc +#undef Tcl_AttemptRealloc + #ifdef TCL_MEM_DEBUG /* @@ -30,12 +36,12 @@ typedef struct MemTag { int refCount; /* Number of mem_headers referencing this * tag. */ - char string[4]; /* Actual size of string will be as large as + char string[1]; /* 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) +#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1) + bytesInString)) static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set * by "memory tag" command). */ @@ -52,7 +58,7 @@ struct mem_header { struct mem_header *blink; MemTag *tagPtr; /* Tag from "memory tag" command; may be * NULL. */ - CONST char *file; + const char *file; long length; int line; unsigned char low_guard[LOW_GUARD_SIZE]; @@ -126,11 +132,11 @@ static int ckallocInit = 0; */ static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char *argv[]); + int argc, const char *argv[]); static int MemoryCmd(ClientData clientData, Tcl_Interp *interp, - int argc, CONST char *argv[]); + int argc, const char *argv[]); static void ValidateMemory(struct mem_header *memHeaderP, - CONST char *file, int line, int nukeGuards); + const char *file, int line, int nukeGuards); /* *---------------------------------------------------------------------- @@ -164,11 +170,15 @@ TclInitDbCkalloc(void) */ int -TclDumpMemoryInfo(ClientData clientData, int flags) +TclDumpMemoryInfo( + ClientData clientData, + int flags) { char buf[1024]; - if (clientData == NULL) { return 0; } + if (clientData == NULL) { + return 0; + } sprintf(buf, "total mallocs %10d\n" "total frees %10d\n" @@ -183,7 +193,7 @@ TclDumpMemoryInfo(ClientData clientData, int flags) maximum_malloc_packets, (unsigned long)maximum_bytes_malloced); if (flags == 0) { - fprintf((FILE *)clientData, buf); + fprintf((FILE *)clientData, "%s", buf); } else { /* Assume objPtr to append to */ Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1); @@ -212,7 +222,7 @@ static void ValidateMemory( struct mem_header *memHeaderP, /* Memory chunk to validate */ - CONST char *file, /* File containing the call to + const char *file, /* File containing the call to * Tcl_ValidateAllMemory */ int line, /* Line number of call to * Tcl_ValidateAllMemory */ @@ -238,7 +248,7 @@ ValidateMemory( if (guard_failed) { TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "low guard failed at %lx, %s %d\n", - (long unsigned int) memHeaderP->body, file, line); + (long unsigned) 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); @@ -260,7 +270,7 @@ ValidateMemory( if (guard_failed) { TclDumpMemoryInfo((ClientData) stderr, 0); fprintf(stderr, "high guard failed at %lx, %s %d\n", - (long unsigned int) memHeaderP->body, file, line); + (long unsigned) 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, @@ -293,7 +303,7 @@ ValidateMemory( void Tcl_ValidateAllMemory( - CONST char *file, /* File from which Tcl_ValidateAllMemory was + const char *file, /* File from which Tcl_ValidateAllMemory was * called. */ int line) /* Line number of call to * Tcl_ValidateAllMemory */ @@ -327,7 +337,7 @@ Tcl_ValidateAllMemory( int Tcl_DumpActiveMemory( - CONST char *fileName) /* Name of the file to write info to */ + const char *fileName) /* Name of the file to write info to */ { FILE *fileP; struct mem_header *memScanP; @@ -344,10 +354,10 @@ Tcl_DumpActiveMemory( Tcl_MutexLock(ckallocMutexPtr); for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) { - address = &memScanP->body [0]; + address = &memScanP->body[0]; fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s", - (long unsigned int) address, - (long unsigned int) address + memScanP->length - 1, + (long unsigned) address, + (long unsigned) address + memScanP->length - 1, memScanP->length, memScanP->file, memScanP->line, (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string); (void) fputc('\n', fileP); @@ -381,7 +391,7 @@ Tcl_DumpActiveMemory( char * Tcl_DbCkalloc( unsigned int size, - CONST char *file, + const char *file, int line) { struct mem_header *result = NULL; @@ -451,11 +461,7 @@ Tcl_DbCkalloc( 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(); + Tcl_Panic("reached malloc break limit (%d)", total_mallocs); } current_malloc_packets++; @@ -475,7 +481,7 @@ Tcl_DbCkalloc( char * Tcl_AttemptDbCkalloc( unsigned int size, - CONST char *file, + const char *file, int line) { struct mem_header *result = NULL; @@ -544,11 +550,7 @@ Tcl_AttemptDbCkalloc( 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(); + Tcl_Panic("reached malloc break limit (%d)", total_mallocs); } current_malloc_packets++; @@ -586,7 +588,7 @@ Tcl_AttemptDbCkalloc( void Tcl_DbCkfree( char *ptr, - CONST char *file, + const char *file, int line) { struct mem_header *memp; @@ -665,7 +667,7 @@ char * Tcl_DbCkrealloc( char *ptr, unsigned int size, - CONST char *file, + const char *file, int line) { char *newPtr; @@ -696,7 +698,7 @@ char * Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, - CONST char *file, + const char *file, int line) { char *newPtr; @@ -744,12 +746,6 @@ Tcl_AttemptDbCkrealloc( *---------------------------------------------------------------------- */ -#undef Tcl_Alloc -#undef Tcl_Free -#undef Tcl_Realloc -#undef Tcl_AttemptAlloc -#undef Tcl_AttemptRealloc - char * Tcl_Alloc( unsigned int size) @@ -814,34 +810,36 @@ MemoryCmd( ClientData clientData, Tcl_Interp *interp, int argc, - CONST char *argv[]) + const char *argv[]) { - CONST char *fileName; + const char *fileName; FILE *fileP; Tcl_DString buffer; int result; size_t len; if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option [args..]\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s option [args..]\"", argv[0])); return TCL_ERROR; } - if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) { + 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); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s file\"", + argv[0], argv[1])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); if (fileName == NULL) { return TCL_ERROR; } - result = Tcl_DumpActiveMemory (fileName); + result = Tcl_DumpActiveMemory(fileName); Tcl_DStringFree(&buffer); if (result != TCL_OK) { - Tcl_AppendResult(interp, "error accessing ", argv[2], NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s", + argv[2], Tcl_PosixError(interp))); return TCL_ERROR; } return TCL_OK; @@ -860,22 +858,22 @@ MemoryCmd( "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n", "total mallocs", total_mallocs, "total frees", total_frees, "current packets allocated", current_malloc_packets, - "current bytes allocated", current_bytes_malloced, + "current bytes allocated", (unsigned long)current_bytes_malloced, "maximum packets allocated", maximum_malloc_packets, - "maximum bytes allocated", maximum_bytes_malloced)); + "maximum bytes allocated", (unsigned long)maximum_bytes_malloced)); return TCL_OK; } - if (strcmp(argv[1],"init") == 0) { + 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],"objs") == 0) { + if (strcmp(argv[1], "objs") == 0) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " objs file\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s objs file\"", argv[0])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); @@ -884,7 +882,9 @@ MemoryCmd( } fileP = fopen(fileName, "w"); if (fileP == NULL) { - Tcl_AppendResult(interp, "cannot open output file", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "cannot open output file: %s", + Tcl_PosixError(interp))); return TCL_ERROR; } TclDbDumpActiveObjects(fileP); @@ -894,8 +894,8 @@ MemoryCmd( } if (strcmp(argv[1],"onexit") == 0) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " onexit file\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s onexit file\"", argv[0])); return TCL_ERROR; } fileName = Tcl_TranslateFileName(interp, argv[2], &buffer); @@ -909,8 +909,8 @@ MemoryCmd( } if (strcmp(argv[1],"tag") == 0) { if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " tag string\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s tag string\"", argv[0])); return TCL_ERROR; } if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) { @@ -947,19 +947,20 @@ MemoryCmd( 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); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad option \"%s\": should be active, break_on_malloc, info, " + "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate", + argv[1])); return TCL_ERROR; argError: - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " count\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s count\"", argv[0], argv[1])); return TCL_ERROR; bad_suboption: - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ", argv[1], " on|off\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1])); return TCL_ERROR; } @@ -986,11 +987,11 @@ CheckmemCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter for evaluation. */ int argc, /* Number of arguments. */ - CONST char *argv[]) /* String values of arguments. */ + const char *argv[]) /* String values of arguments. */ { if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " fileName\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: should be \"%s fileName\"", argv[0])); return TCL_ERROR; } tclMemDumpFileName = dumpFile; @@ -1020,8 +1021,8 @@ Tcl_InitMemory( * added */ { TclInitDbCkalloc(); - Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL); - Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL); + Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } @@ -1072,7 +1073,7 @@ Tcl_Alloc( char * Tcl_DbCkalloc( unsigned int size, - CONST char *file, + const char *file, int line) { char *result; @@ -1110,7 +1111,7 @@ Tcl_AttemptAlloc( char * Tcl_AttemptDbCkalloc( unsigned int size, - CONST char *file, + const char *file, int line) { char *result; @@ -1149,7 +1150,7 @@ char * Tcl_DbCkrealloc( char *ptr, unsigned int size, - CONST char *file, + const char *file, int line) { char *result; @@ -1189,7 +1190,7 @@ char * Tcl_AttemptDbCkrealloc( char *ptr, unsigned int size, - CONST char *file, + const char *file, int line) { char *result; @@ -1220,7 +1221,7 @@ Tcl_Free( void Tcl_DbCkfree( char *ptr, - CONST char *file, + const char *file, int line) { TclpFree(ptr); @@ -1245,20 +1246,22 @@ Tcl_InitMemory( int Tcl_DumpActiveMemory( - CONST char *fileName) + const char *fileName) { return TCL_OK; } void Tcl_ValidateAllMemory( - CONST char *file, + const char *file, int line) { } int -TclDumpMemoryInfo(ClientData clientData, int flags) +TclDumpMemoryInfo( + ClientData clientData, + int flags) { return 1; } @@ -1315,5 +1318,7 @@ TclFinalizeMemorySubsystem(void) * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 + * indent-tabs-mode: nil * End: */ |