tclckalloc.c

linux系统下的音频通信

    }

    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
     */
    if (memp->flink != NULL)
        memp->flink->blink = memp->blink;
    if (memp->blink != NULL)
        memp->blink->flink = memp->flink;
    if (allocHead == memp)
        allocHead = memp->flink;
    TclpFree((char *) memp);
    return 0;
}

/*
 *--------------------------------------------------------------------
 *
 * Tcl_DbCkrealloc - debugging ckrealloc
 *
 *	Reallocate a chunk of memory by allocating a new one of the
 *	right size, copying the old data to the new location, and then
 *	freeing the old memory space, using all the memory checking
 *	features of this package.
 *
 *--------------------------------------------------------------------
 */
char *
Tcl_DbCkrealloc(ptr, size, file, line)
    char *ptr;
    unsigned int size;
    char *file;
    int line;
{
    char *new;
    unsigned int copySize;

    /*
     * See comment from Tcl_DbCkfree before you change the following
     * line.
     */

    struct mem_header *memp = (struct mem_header *)
	    (((unsigned long) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > (unsigned int) memp->length) {
	copySize = memp->length;
    }
    new = Tcl_DbCkalloc(size, file, line);
    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return(new);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Alloc, et al. --
 *
 *	These functions are defined in terms of the debugging versions
 *	when TCL_MEM_DEBUG is set.
 *
 * Results:
 *	Same as the debug versions.
 *
 * Side effects:
 *	Same as the debug versions.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc

char *
Tcl_Alloc(size)
    unsigned int size;
{
    return Tcl_DbCkalloc(size, "unknown", 0);
}

void
Tcl_Free(ptr)
    char *ptr;
{
    Tcl_DbCkfree(ptr, "unknown", 0);
}

char *
Tcl_Realloc(ptr, size)
    char *ptr;
    unsigned int size;
{
    return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}

/*
 *----------------------------------------------------------------------
 *
 * MemoryCmd --
 *     Implements the TCL memory command:
 *       memory info
 *       memory display
 *       break_on_malloc count
 *       trace_on_at_malloc count
 *       trace on|off
 *       validate on|off
 *
 * Results:
 *     Standard TCL results.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */
static int
MemoryCmd (clientData, interp, argc, argv)
    ClientData  clientData;
    Tcl_Interp *interp;
    int         argc;
    char      **argv;
{
    char *fileName;
    Tcl_DString buffer;
    int result;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option [args..]\"", (char *) NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1],"active") == 0) {
        if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"",
		    argv[0], " active file\"", (char *) NULL);
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory (fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_AppendResult(interp, "error accessing ", argv[2], 
		    (char *) NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(argv[1],"break_on_malloc") == 0) {
        if (argc != 3) {
            goto argError;
	}
        if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
	    return TCL_ERROR;
	}
        return TCL_OK;
    }
    if (strcmp(argv[1],"info") == 0) {
        TclDumpMemoryInfo(stdout);
        return TCL_OK;
    }
    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],"tag") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " tag string\"", (char *) NULL);
	    return TCL_ERROR;
	}
	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
	    TclpFree((char *) curTagPtr);
	}
	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2])));
	curTagPtr->refCount = 0;
	strcpy(curTagPtr->string, argv[2]);
	return TCL_OK;
    }
    if (strcmp(argv[1],"trace") == 0) {
        if (argc != 3) {
            goto bad_suboption;
	}
        alloc_tracing = (strcmp(argv[2],"on") == 0);
        return TCL_OK;
    }

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

    Tcl_AppendResult(interp, "bad option \"", argv[1],
	    "\": should be active, break_on_malloc, info, init, ",
	    "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
    return TCL_ERROR;

argError:
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	    " ", argv[1], " count\"", (char *) NULL);
    return TCL_ERROR;

bad_suboption:
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	    " ", argv[1], " on|off\"", (char *) NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitMemory --
 *     Initialize the memory command.
 *
 *----------------------------------------------------------------------
 */
void
Tcl_InitMemory(interp)
    Tcl_Interp *interp;
{
    Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL, 
	    (Tcl_CmdDeleteProc *) NULL);
}

#else


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Alloc --
 *     Interface to TclpAlloc when TCL_MEM_DEBUG is disabled.  It does check
 *     that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

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

        result = TclpAlloc(size);
        if (result == NULL) 
                panic("unable to alloc %d bytes", size);
        return result;
}

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

    result = (char *) TclpAlloc(size);

    if (result == NULL) {
        fflush(stdout);
        panic("unable to alloc %d bytes, %s line %d", size, file, 
              line);
    }
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Realloc --
 *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does 
 *     check that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

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

    result = TclpRealloc(ptr, size);
    if (result == NULL) 
	panic("unable to realloc %d bytes", size);
    return result;
}

char *
Tcl_DbCkrealloc(ptr, size, file, line)
    char *ptr;
    unsigned int size;
    char *file;
    int line;
{
    char *result;

    result = (char *) TclpRealloc(ptr, size);

    if (result == NULL) {
        fflush(stdout);
        panic("unable to realloc %d bytes, %s line %d", size, file, 
              line);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Free --
 *     Interface to TclpFree when TCL_MEM_DEBUG is disabled.  Done here
 *     rather in the macro to keep some modules from being compiled with 
 *     TCL_MEM_DEBUG enabled and some with it disabled.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Free (ptr)
    char *ptr;
{
        TclpFree(ptr);
}

int
Tcl_DbCkfree(ptr, file, line)
    char *  ptr;
    char     *file;
    int       line;
{
    TclpFree(ptr);
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitMemory --
 *     Dummy initialization for memory command, which is only available 
 *     if TCL_MEM_DEBUG is on.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */
void
Tcl_InitMemory(interp)
    Tcl_Interp *interp;
{
}

#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory

extern int		Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
extern void		Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
			    int line));

int
Tcl_DumpActiveMemory(fileName)
    char *fileName;
{
    return TCL_OK;
}

void
Tcl_ValidateAllMemory(file, line)
    char  *file;
    int    line;
{
}

#endif