tclckalloc.c

tcl是工具命令语言

/* 
 * 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.19 2003/01/19 07:21:18 hobbs Exp $
 */

#include "tclInt.h"
#include "tclPort.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 _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, CONST char *argv[]));
static int		MemoryCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, CONST char **argv));
static void		ValidateMemory _ANSI_ARGS_((
			    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() 
{
    if (!ckallocInit) {
	ckallocInit = 1;
	ckallocMutexPtr = Tcl_GetAllocMutex();
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclDumpMemoryInfo --
 *     Display the global memory management statistics.
 *
 *----------------------------------------------------------------------
 */
void
TclDumpMemoryInfo(outFile) 
    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(memHeaderP, file, line, nukeGuards)
    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;
    int   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", 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);
        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", 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);
        panic("Memory validation failure");
    }

    if (nukeGuards) {
        memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); 
        memset ((char *) 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 (file, line)
    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 (fileName)
    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(size, file, line)
    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);
        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 ((VOID *) result, GUARD_VALUE,
		size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    } else {
	memset ((char *) 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);