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 int		CheckmemCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		MemoryCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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[])
    int objc,			/* Number of arguments. */
	Tcl_Obj *const objv[])		/* Obj values of arguments. */
{
    const char *fileName;
    FILE *fileP;
    Tcl_DString buffer;
    int result;
    size_t len;

    if (argc < 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "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) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
                    "wrong # args: should be \"%s %s file\"",
                    argv[0], argv[1]));
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[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)));
                    TclGetString(objv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(argv[1],"break_on_malloc") == 0) {
    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
	int value;
	if (argc != 3) {
	if (objc != 3) {
	    goto argError;
	}
	if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
	if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	break_on_malloc = (unsigned int) value;
	return TCL_OK;
    }
    if (strcmp(argv[1],"info") == 0) {
    if (strcmp(TclGetString(objv[1]),"info") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\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) {
    if (strcmp(TclGetString(objv[1]), "init") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(argv[2],"on") == 0);
	init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }
    if (strcmp(argv[1], "objs") == 0) {
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (strcmp(TclGetString(objv[1]), "objs") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
                    "wrong # args: should be \"%s objs file\"", argv[0]));
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[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) {
	if (argc != 3) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (strcmp(TclGetString(objv[1]),"onexit") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
                    "wrong # args: should be \"%s onexit file\"", argv[0]));
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[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_SetObjResult(interp, Tcl_ObjPrintf(
    if (strcmp(TclGetString(objv[1]),"tag") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
                    "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(TclGetString(objv[2]));
	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
	curTagPtr->refCount = 0;
	memcpy(curTagPtr->string, argv[2], len + 1);
	memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1);
	return TCL_OK;
    }
    if (strcmp(argv[1],"trace") == 0) {
	if (argc != 3) {
    if (strcmp(TclGetString(objv[1]),"trace") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	alloc_tracing = (strcmp(argv[2],"on") == 0);
	alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }

    if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
    if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) {
	int value;
	if (argc != 3) {
	if (objc != 3) {
	    goto argError;
	}
	if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
	if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	trace_on_at_malloc = value;
	return TCL_OK;
    }
    if (strcmp(argv[1],"validate") == 0) {
	if (argc != 3) {
    if (strcmp(TclGetString(objv[1]),"validate") == 0) {
	if (objc != 3) {
	    goto bad_suboption;
	}
	validate_memory = (strcmp(argv[2],"on") == 0);
	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }

    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]));
            TclGetString(objv[1])));
    return TCL_ERROR;

  argError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    Tcl_WrongNumArgs(interp, 2, objv, "count");
            "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
    return TCL_ERROR;

  bad_suboption:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    Tcl_WrongNumArgs(interp, 2, objv, "on|off");
            "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
    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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

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. */
    int objc,			/* Number of arguments. */
	Tcl_Obj *const objv[])		/* Obj values of arguments. */
{
    if (argc != 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
                "wrong # args: should be \"%s fileName\"", argv[0]));
	return TCL_ERROR;
    }
    tclMemDumpFileName = dumpFile;
    strcpy(tclMemDumpFileName, argv[1]);
    strcpy(tclMemDumpFileName, TclGetString(objv[1]));
    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 */