static int ckallocInit = 0;

/*
 * Prototypes for procedures defined in this file:
 */

static int		CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
			    int argc, const char *argv[]);
			    int argc, Tcl_Obj *const argv[]);
static int		MemoryCmd(ClientData clientData, Tcl_Interp *interp,
			    int argc, const char *argv[]);
			    int argc, Tcl_Obj *const argv[]);
static void		ValidateMemory(struct mem_header *memHeaderP,
			    const char *file, int line, int nukeGuards);

/*
 *----------------------------------------------------------------------
 *
 * TclInitDbCkalloc --

 */
	/* ARGSUSED */
static int
MemoryCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int argc,
    const char *argv[])
    Tcl_Obj *const argv[])
{
    const char *fileName;
    FILE *fileP;
    Tcl_DString buffer;
    int result;
    int result, idx;
    size_t len;
    static const char *subcommands[] = {
        "active", "display", "break_on_malloc", "info", "init", "objs",
        "onexit", "tag", "trace", "trace_on_at_malloc", "validate",
        NULL
    };
    enum MemSubcommands {
        OPT_ACTIVE, OPT_DISPLAY, OPT_BREAK, OPT_INFO, OPT_INIT, OPT_OBJS,
        OPT_ONEXIT, OPT_TAG, OPT_TRACE, OPT_TRACEON, OPT_VALIDATE
    };

    if (argc < 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
        Tcl_WrongNumArgs(interp, 1, argv, "option [args..]");
                "wrong # args: should be \"%s option [args..]\"", argv[0]));
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) {
	if (argc != 3) {
    if (Tcl_GetIndexFromObj(interp, argv[1], subcommands, "option", 0,
            &idx) != TCL_OK) {
	    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);
        return TCL_ERROR;
    }

    switch ((enum MemSubcommands) idx) {
    case OPT_ACTIVE:
    case OPT_DISPLAY:
	if (argc != 3) {
            goto missingFile;
	}
	fileName = Tcl_TranslateFileName(interp, Tcl_GetString(argv[2]),
                &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
                    argv[2], Tcl_PosixError(interp)));
                    Tcl_GetString(argv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(argv[1],"break_on_malloc") == 0) {

    case OPT_BREAK:
	if (argc != 3) {
	    goto argError;
	    goto missingCount;
	}
	if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
	return Tcl_GetIntFromObj(interp, argv[2], &break_on_malloc);
	    return TCL_ERROR;
	}

	return TCL_OK;
    }
    if (strcmp(argv[1],"info") == 0) {
    case OPT_INFO:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-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", (unsigned long)current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
	return TCL_OK;
    }
    if (strcmp(argv[1], "init") == 0) {

    case OPT_INIT:
	if (argc != 3) {
	    goto bad_suboption;
	    goto missingBoolean;
	}
	init_malloced_bodies = (strcmp(argv[2],"on") == 0);
        return Tcl_GetBooleanFromObj(interp, argv[2], &init_malloced_bodies);
	return TCL_OK;
    }

    if (strcmp(argv[1], "objs") == 0) {
    case OPT_OBJS:
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "wrong # args: should be \"%s objs file\"", argv[0]));
	    return TCL_ERROR;
            goto missingFile;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	fileName = Tcl_TranslateFileName(interp, Tcl_GetString(argv[2]),
                &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "cannot open output file: %s",
                    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(argv[1],"onexit") == 0) {

    case OPT_ONEXIT:
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            goto missingFile;
                    "wrong # args: should be \"%s onexit file\"", argv[0]));
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	fileName = Tcl_TranslateFileName(interp, Tcl_GetString(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) {

    case OPT_TAG:
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            Tcl_WrongNumArgs(interp, 2, argv, "string");
                    "wrong # args: should be \"%s tag string\"", argv[0]));
	    return TCL_ERROR;
	}
	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
	    TclpFree((char *) curTagPtr);
	}
	len = strlen(argv[2]);
	len = strlen(Tcl_GetString(argv[2]));
	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
	curTagPtr->refCount = 0;
	memcpy(curTagPtr->string, argv[2], len + 1);
	memcpy(curTagPtr->string, Tcl_GetString(argv[2]), len + 1);
	return TCL_OK;
    }
    if (strcmp(argv[1],"trace") == 0) {

    case OPT_TRACE:
	if (argc != 3) {
	    goto bad_suboption;
	    goto missingBoolean;
	}
	alloc_tracing = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }

        return Tcl_GetBooleanFromObj(interp, argv[2], &alloc_tracing);

    case OPT_TRACEON:
    if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
	if (argc != 3) {
	    goto argError;
	    goto missingCount;
	}
	if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
	return Tcl_GetIntFromObj(interp, argv[2], &trace_on_at_malloc);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(argv[1],"validate") == 0) {

    case OPT_VALIDATE:
	if (argc != 3) {
	    goto bad_suboption;
	    goto missingBoolean;
	}
	validate_memory = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
        return Tcl_GetBooleanFromObj(interp, argv[2], &validate_memory);
    }

  missingCount:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    Tcl_WrongNumArgs(interp, 2, argv, "count");
            "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_SetObjResult(interp, Tcl_ObjPrintf(
  missingFile:
    Tcl_WrongNumArgs(interp, 2, argv, "file");
            "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
    return TCL_ERROR;

  bad_suboption:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  missingBoolean:
    Tcl_WrongNumArgs(interp, 2, argv, "on|off");
            "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * CheckmemCmd --

 */

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. */
    Tcl_Obj *const argv[])	/* Values of arguments. */
{
    char *bytes;
    int len;

    if (argc != 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "wrong # args: should be \"%s fileName\"", argv[0]));
	return TCL_ERROR;
        Tcl_WrongNumArgs(interp, 1, argv, "fileName");
	return TCL_ERROR;
    }
    bytes = Tcl_GetStringFromObj(argv[1], &len);
    if (len > 99) {
        Tcl_SetResult(interp, "string too long for internal buffer",
                TCL_STATIC);
        return TCL_ERROR;
    }
    tclMemDumpFileName = dumpFile;
    strcpy(tclMemDumpFileName, argv[1]);
    strcpy(tclMemDumpFileName, bytes);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitMemory --

void
Tcl_InitMemory(
    Tcl_Interp *interp)		/* Interpreter in which commands should be
				 * added */
{
    TclInitDbCkalloc();
    Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
}


#else	/* TCL_MEM_DEBUG */

/* This is the !TCL_MEM_DEBUG case */

 *----------------------------------------------------------------------
 */

char *
Tcl_Alloc(
    unsigned int size)
{
    char *result;
    char *result = (char *) TclpAlloc(size);

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

char *
Tcl_DbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{
    char *result;

    result = (char *) TclpAlloc(size);
    char *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;
}

 *----------------------------------------------------------------------
 */

char *
Tcl_AttemptAlloc(
    unsigned int size)
{
    char *result;

    result = TclpAlloc(size);
    return (char *) TclpAlloc(size);
    return result;
}

char *
Tcl_AttemptDbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{
    char *result;

    result = (char *) TclpAlloc(size);
    return (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;
    char *result = (char *) TclpRealloc(ptr, size);

    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);
    char *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;
}

 */

char *
Tcl_AttemptRealloc(
    char *ptr,
    unsigned int size)
{
    char *result;

    result = TclpRealloc(ptr, size);
    return (char *) 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 (char *) TclpRealloc(ptr, size);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Free --
 *