/*
 * One of the following structures is allocated each time the
 * "memory tag" command is invoked, to hold the current tag.
 */

typedef struct {
    int refCount;		/* Number of mem_headers referencing this
				 * tag. */
    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) ((TclOffset(MemTag, string) + 1) + bytesInString))

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. */

	    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((ClientData) stderr, 0);
	fprintf(stderr, "low guard failed at %lx, %s %d\n",
		(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);
	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((ClientData) stderr, 0);
	fprintf(stderr, "high guard failed at %lx, %s %d\n",
		(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);
	Tcl_Panic("Memory validation failure");
    }

    if (nukeGuards) {
	memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
	memset(hiPtr, 0, HIGH_GUARD_SIZE);

	    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) address,
		(long unsigned) 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);

		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);
	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
    }

		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);
	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
    }

     * such as Crays (will subtract only bytes, even though BODY_OFFSET is in
     * words on these machines).
     */

    memp = (struct mem_header *) (((size_t) 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
     */

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 *) (((size_t) 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 *) (((size_t) 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);