Changeset 7692efc in git for external/tcl

Timestamp:

Aug 16, 2019, 11:14:50 AM (5 years ago)

Author:

Michele Selvaggi <michele.selvaggi@…>

Branches:

ImprovedOutputFile, Timing, master

Children:

0e7d64a

Parents:

94f8f5f (diff), 270bd4f (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent.

Message:

Merge branch 'master' of github.com:delphes/delphes

Location:

external/tcl

Files:

• tcl.h (modified) (5 diffs)
• tclBasic.c (modified) (1 diff)
• tclCkalloc.c (modified) (4 diffs)
• tclCompExpr.c (modified) (17 diffs)
• tclCompile.c (modified) (8 diffs)
• tclCompile.h (modified) (2 diffs)
• tclExecute.c (modified) (116 diffs)
• tclInt.h (modified) (6 diffs)
• tclListObj.c (modified) (3 diffs)
• tclObj.c (modified) (26 diffs)
• tclProc.c (modified) (2 diffs)
• tclStringObj.c (modified) (4 diffs)
• tclVar.c (modified) (4 diffs)

external/tcl/tcl.h

@@ -488 +488 @@
 EXTERN int              Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
 
-#ifdef TCL_MEM_DEBUG
-#   define Tcl_IncrRefCount(objPtr) \
-        Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
-#   define Tcl_DecrRefCount(objPtr) \
-        Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
-#   define Tcl_IsShared(objPtr) \
-        Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
-#else
 #   define Tcl_IncrRefCount(objPtr) \
         ++(objPtr)->refCount
@@ -502 +494 @@
 #   define Tcl_IsShared(objPtr) \
         ((objPtr)->refCount > 1)
-#endif
 
 /*
  * Macros and definitions that help to debug the use of Tcl objects.
- * When TCL_MEM_DEBUG is defined, the Tcl_New* declarations are 
- * overridden to call debugging versions of the object creation procedures.
  */
 
@@ -519 +508 @@
 EXTERN Tcl_Obj *        Tcl_NewStringObj _ANSI_ARGS_((char *bytes,
                             int length));
-
-#ifdef TCL_MEM_DEBUG
-#  define Tcl_NewBooleanObj(val) \
-     Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
-#  define Tcl_NewDoubleObj(val) \
-     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
-#  define Tcl_NewIntObj(val) \
-     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
-#  define Tcl_NewListObj(objc, objv) \
-     Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
-#  define Tcl_NewLongObj(val) \
-     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
-#  define Tcl_NewObj() \
-     Tcl_DbNewObj(__FILE__, __LINE__)
-#  define Tcl_NewStringObj(bytes, len) \
-     Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
-#endif /* TCL_MEM_DEBUG */
 
 /*
@@ -726 +698 @@
                             unsigned int size));
 
-#ifdef TCL_MEM_DEBUG
-
-#  define Tcl_Alloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
-#  define Tcl_Free(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
-#  define Tcl_Realloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
-#  define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
-#  define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
-#  define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
-
-EXTERN int              Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
-EXTERN void             Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
-                            int line));
-
-#else
-
 /*
  * If USE_TCLALLOC is true, then we need to call Tcl_Alloc instead of
@@ -760 +717 @@
 #  define Tcl_DumpActiveMemory(x)
 #  define Tcl_ValidateAllMemory(x,y)
-
-#endif /* TCL_MEM_DEBUG */
 
 /*

external/tcl/tclBasic.c

@@ -3287 +3287 @@
             TclInitByteCodeObj(objPtr, &compEnv);
             codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
-            if (tclTraceCompile == 2) {
-                TclPrintByteCodeObj(interp, objPtr);
-            }
             TclFreeCompileEnv(&compEnv);
         } else {

external/tcl/tclCkalloc.c

@@ -22 +22 @@
 #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. */
-    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
-
-/*
- * Prototypes for procedures defined in this file:
- */
-
-static int              MemoryCmd _ANSI_ARGS_((ClientData clientData,
-                            Tcl_Interp *interp, int argc, char **argv));
-static void             ValidateMemory _ANSI_ARGS_((
-                            struct mem_header *memHeaderP, char *file,
-                            int line, int nukeGuards));
-
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 --
- *     Procedure to validate allocted memory guard zones.
- *
- *----------------------------------------------------------------------
- */
-static void
-ValidateMemory(memHeaderP, file, line, nukeGuards)
-    struct mem_header *memHeaderP;
-    char              *file;
-    int                line;
-    int                nukeGuards;
-{
-    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 : ' '));
-        }
-    }
-    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 : ' '));
-        }
-    }
-
-    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 --
- *     Validates guard regions for all allocated memory.
- *
- *----------------------------------------------------------------------
- */
-void
-Tcl_ValidateAllMemory (file, line)
-    char  *file;
-    int    line;
-{
-    struct mem_header *memScanP;
-
-    for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
-        ValidateMemory(memScanP, file, line, FALSE);
-
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DumpActiveMemory --
- *     Displays all allocated memory to stderr.
- *
- * Results:
- *     Return TCL_ERROR if an error accessing the file occures, `errno' 
- *     will have the file error number left in it.
- *----------------------------------------------------------------------
- */
-int
-Tcl_DumpActiveMemory (fileName)
-    char *fileName;
-{
-    FILE              *fileP;
-    struct mem_header *memScanP;
-    char              *address;
-
-    fileP = fopen(fileName, "w");
-    if (fileP == NULL)
-        return TCL_ERROR;
-
-    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);
-    }
-    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;
-    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 %d 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);
-    }
-    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);
-        fflush(stderr);
-        alloc_tracing = TRUE;
-        trace_on_at_malloc = 0;
-    }
-
-    if (alloc_tracing)
-        fprintf(stderr,"ckalloc %lx %d %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);
-        fprintf(stderr,"reached malloc break limit (%d)\n", 
-                total_mallocs);
-        fprintf(stderr, "program will now enter C debugger\n");
-        (void) fflush(stderr);
-        abort();
-    }
-
-    current_malloc_packets++;
-    if (current_malloc_packets > maximum_malloc_packets)
-        maximum_malloc_packets = current_malloc_packets;
-    current_bytes_malloced += size;
-    if (current_bytes_malloced > maximum_bytes_malloced)
-        maximum_bytes_malloced = current_bytes_malloced;
-
-    return result->body;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbCkfree - debugging ckfree
- *
- *        Verify that the low and high guards are intact, and if so
- *        then free the buffer else panic.
- *
- *        The guards are erased after being checked to catch duplicate
- *        frees.
- *
- *        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 ckfree macro; it uses the preprocessor
- *        autodefines __FILE__ and __LINE__.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_DbCkfree(ptr, file, line)
-    char *  ptr;
-    char     *file;
-    int       line;
-{
-    /*
-     * The following cast is *very* tricky.  Must convert the pointer
-     * to an integer before doing arithmetic on it, because otherwise
-     * the arithmetic will be done differently (and incorrectly) on
-     * word-addressed machines such as Crays (will subtract only bytes,
-     * even though BODY_OFFSET is in words on these machines).
-     */
-
-    struct mem_header *memp = (struct mem_header *)
-            (((unsigned long) 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);
-
-    ValidateMemory(memp, file, line, TRUE);
-    if (init_malloced_bodies) {
-        memset((VOID *) 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
-     */
-    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.
+ *      Interface to TclpAlloc.
+ *      It does check that memory was actually allocated.
  *
  *----------------------------------------------------------------------
@@ -722 +68 @@
  *
  * Tcl_Realloc --
- *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does 
- *     check that memory was actually allocated.
+ *      Interface to TclpRealloc.
+ *      It does check that memory was actually allocated.
  *
  *----------------------------------------------------------------------
@@ -765 +111 @@
  *
  * 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.
+ *      Interface to TclpFree.
  *
  *----------------------------------------------------------------------
@@ -778 +122 @@
         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

external/tcl/tclCompExpr.c

@@ -31 +31 @@
 #define ERANGE 34
 #endif
-
-/*
- * Boolean variable that controls whether expression compilation tracing
- * is enabled.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-static int traceCompileExpr = 0;
-#endif /* TCL_COMPILE_DEBUG */
 
 /*
@@ -132 +123 @@
 #define NOT             (COLON + 1)
 #define BIT_NOT         (NOT + 1)
-
-/*
- * Mapping from tokens to strings; used for debugging messages. These
- * entries must match the order and number of the token definitions above.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-static char *tokenStrings[] = {
-    "LITERAL", "FUNCNAME",
-    "[", "]", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
-    "*", "/", "%", "+", "-",
-    "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
-    "&", "^", "|", "&&", "||", "?", ":",
-    "!", "~"
-};
-#endif /* TCL_COMPILE_DEBUG */
 
 /*
@@ -198 +173 @@
                             ExprInfo *infoPtr, CompileEnv *envPtr));
 
-/*
- * Macro used to debug the execution of the recursive descent parser used
- * to compile expressions.
- */
-
-#ifdef TCL_COMPILE_DEBUG
-#define HERE(production, level) \
-    if (traceCompileExpr) { \
-        fprintf(stderr, "%*s%s: token=%s, next=\"%.20s\"\n", \
-                (level), " ", (production), tokenStrings[infoPtr->token], \
-                infoPtr->next); \
-    }
-#else
-#define HERE(production, level)
-#endif /* TCL_COMPILE_DEBUG */
 
 
@@ -277 +237 @@
                                  * to execute the expression. */
     int result;
-
-#ifdef TCL_COMPILE_DEBUG
-    if (traceCompileExpr) {
-        fprintf(stderr, "expr: string=\"%.30s\"\n", string);
-    }
-#endif /* TCL_COMPILE_DEBUG */
 
     /*
@@ -409 +363 @@
     int elseCodeOffset, currCodeOffset, jumpDist, result;
     
-    HERE("condExpr", 1);
     result = CompileLorExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -571 +524 @@
     Tcl_Obj *objPtr;
     
-    HERE("lorExpr", 2);
     result = CompileLandExpr(interp, infoPtr, flags, envPtr);
     if ((result != TCL_OK) || (infoPtr->token != OR)) {
@@ -739 +691 @@
     Tcl_Obj *objPtr;
 
-    HERE("landExpr", 3);
     result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
     if ((result != TCL_OK) || (infoPtr->token != AND)) {
@@ -899 +850 @@
     int result;
 
-    HERE("bitOrExpr", 4);
     result = CompileBitXorExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -970 +920 @@
     int result;
 
-    HERE("bitXorExpr", 5);
     result = CompileBitAndExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -1041 +990 @@
     int result;
 
-    HERE("bitAndExpr", 6);
     result = CompileEqualityExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -1112 +1060 @@
     int op, result;
 
-    HERE("equalityExpr", 7);
     result = CompileRelationalExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -1190 +1137 @@
     int op, result;
 
-    HERE("relationalExpr", 8);
     result = CompileShiftExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -1277 +1223 @@
     int op, result;
 
-    HERE("shiftExpr", 9);
     result = CompileAddExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -1355 +1300 @@
     int op, result;
 
-    HERE("addExpr", 10);
     result = CompileMultiplyExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -1433 +1377 @@
     int op, result;
 
-    HERE("multiplyExpr", 11);
     result = CompileUnaryExpr(interp, infoPtr, flags, envPtr);
     if (result != TCL_OK) {
@@ -1513 +1456 @@
     int op, result;
 
-    HERE("unaryExpr", 12);
     op = infoPtr->token;
     if ((op == PLUS) || (op == MINUS) || (op == BIT_NOT) || (op == NOT)) {
@@ -1608 +1550 @@
      */
 
-    HERE("primaryExpr", 13);
     theToken = infoPtr->token;
 

external/tcl/tclCompile.c

@@ -17 +17 @@
 #include "tclInt.h"
 #include "tclCompile.h"
-
-/*
- * Variable that controls whether compilation tracing is enabled and, if so,
- * what level of tracing is desired:
- *    0: no compilation tracing
- *    1: summarize compilation of top level cmds and proc bodies
- *    2: display all instructions of each ByteCode compiled
- * This variable is linked to the Tcl variable "tcl_traceCompile".
- */
-
-int tclTraceCompile = 0;
-static int traceInitialized = 0;
-
-/*
- * Count of the number of compilations and various other compilation-
- * related statistics.
- */
-
-#ifdef TCL_COMPILE_STATS
-long tclNumCompilations = 0;
-double tclTotalSourceBytes = 0.0;
-double tclTotalCodeBytes = 0.0;
-
-double tclTotalInstBytes = 0.0;
-double tclTotalObjBytes = 0.0;
-double tclTotalExceptBytes = 0.0;
-double tclTotalAuxBytes = 0.0;
-double tclTotalCmdMapBytes = 0.0;
-
-double tclCurrentSourceBytes = 0.0;
-double tclCurrentCodeBytes = 0.0;
-
-int tclSourceCount[32];
-int tclByteCodeCount[32];
-#endif /* TCL_COMPILE_STATS */
 
 /*
@@ -443 +408 @@
  *----------------------------------------------------------------------
  *
- * TclPrintByteCodeObj --
- *
- *      This procedure prints ("disassembles") the instructions of a
- *      bytecode object to stdout.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintByteCodeObj(interp, objPtr)
-    Tcl_Interp *interp;         /* Used only for Tcl_GetStringFromObj. */
-    Tcl_Obj *objPtr;            /* The bytecode object to disassemble. */
-{
-    ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
-    unsigned char *codeStart, *codeLimit, *pc;
-    unsigned char *codeDeltaNext, *codeLengthNext;
-    unsigned char *srcDeltaNext, *srcLengthNext;
-    int codeOffset, codeLen, srcOffset, srcLen;
-    int numCmds, numObjs, delta, objBytes, i;
-
-    if (codePtr->refCount <= 0) {
-        return;                 /* already freed */
-    }
-
-    codeStart = codePtr->codeStart;
-    codeLimit = (codeStart + codePtr->numCodeBytes);
-    numCmds = codePtr->numCommands;
-    numObjs = codePtr->numObjects;
-
-    objBytes = (numObjs * sizeof(Tcl_Obj));
-    for (i = 0;  i < numObjs;  i++) {
-        Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
-        if (litObjPtr->bytes != NULL) {
-            objBytes += litObjPtr->length;
-        }
-    }
-
-    /*
-     * Print header lines describing the ByteCode.
-     */
-
-    fprintf(stdout, "\nByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
-            (unsigned int) codePtr, codePtr->refCount,
-            codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
-            codePtr->iPtr->compileEpoch);
-    fprintf(stdout, "  Source ");
-    TclPrintSource(stdout, codePtr->source,
-            TclMin(codePtr->numSrcChars, 70));
-    fprintf(stdout, "\n  Cmds %d, chars %d, inst %d, objs %u, aux %d, stk depth %u, code/src %.2f\n",
-            numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
-            codePtr->numAuxDataItems, codePtr->maxStackDepth,
-            (codePtr->numSrcChars?
-                    ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
-    fprintf(stdout, "  Code %zu = %u(header)+%d(inst)+%d(objs)+%u(exc)+%u(aux)+%d(cmd map)\n",
-            codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
-            objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
-            (codePtr->numAuxDataItems * sizeof(AuxData)),
-            codePtr->numCmdLocBytes);
-
-    /*
-     * If the ByteCode is the compiled body of a Tcl procedure, print
-     * information about that procedure. Note that we don't know the
-     * procedure's name since ByteCode's can be shared among procedures.
-     */
-    
-    if (codePtr->procPtr != NULL) {
-        Proc *procPtr = codePtr->procPtr;
-        int numCompiledLocals = procPtr->numCompiledLocals;
-        fprintf(stdout,
-                "  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
-                (unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
-                numCompiledLocals);
-        if (numCompiledLocals > 0) {
-            CompiledLocal *localPtr = procPtr->firstLocalPtr;
-            for (i = 0;  i < numCompiledLocals;  i++) {
-                fprintf(stdout, "      %d: slot %d%s%s%s%s%s%s",
-                        i, localPtr->frameIndex,
-                        ((localPtr->flags & VAR_SCALAR)?  ", scalar"  : ""),
-                        ((localPtr->flags & VAR_ARRAY)?  ", array"  : ""),
-                        ((localPtr->flags & VAR_LINK)?  ", link"  : ""),
-                        ((localPtr->flags & VAR_ARGUMENT)?  ", arg"  : ""),
-                        ((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
-                        ((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
-                if (TclIsVarTemporary(localPtr)) {
-                    fprintf(stdout,     "\n");
-                } else {
-                    fprintf(stdout,     ", name=\"%s\"\n", localPtr->name);
-                }
-                localPtr = localPtr->nextPtr;
-            }
-        }
-    }
-
-    /*
-     * Print the ExceptionRange array.
-     */
-
-    if (codePtr->numExcRanges > 0) {
-        fprintf(stdout, "  Exception ranges %d, depth %d:\n",
-                codePtr->numExcRanges, codePtr->maxExcRangeDepth);
-        for (i = 0;  i < codePtr->numExcRanges;  i++) {
-            ExceptionRange *rangePtr = &(codePtr->excRangeArrayPtr[i]);
-            fprintf(stdout, "      %d: level %d, %s, pc %d-%d, ",
-                    i, rangePtr->nestingLevel,
-                    ((rangePtr->type == LOOP_EXCEPTION_RANGE)? "loop":"catch"),
-                    rangePtr->codeOffset,
-                    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
-            switch (rangePtr->type) {
-            case LOOP_EXCEPTION_RANGE:
-                fprintf(stdout, "continue %d, break %d\n",
-                        rangePtr->continueOffset, rangePtr->breakOffset);
-                break;
-            case CATCH_EXCEPTION_RANGE:
-                fprintf(stdout, "catch %d\n", rangePtr->catchOffset);
-                break;
-            default:
-                panic("TclPrintSource: unrecognized ExceptionRange type %d\n",
-                        rangePtr->type);
-            }
-        }
-    }
-    
-    /*
-     * If there were no commands (e.g., an expression or an empty string
-     * was compiled), just print all instructions and return.
-     */
-
-    if (numCmds == 0) {
-        pc = codeStart;
-        while (pc < codeLimit) {
-            fprintf(stdout, "    ");
-            pc += TclPrintInstruction(codePtr, pc);
-        }
-        return;
-    }
-    
-    /*
-     * Print table showing the code offset, source offset, and source
-     * length for each command. These are encoded as a sequence of bytes.
-     */
-
-    fprintf(stdout, "  Commands %d:", numCmds);
-    codeDeltaNext = codePtr->codeDeltaStart;
-    codeLengthNext = codePtr->codeLengthStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
-    srcLengthNext = codePtr->srcLengthStart;
-    codeOffset = srcOffset = 0;
-    for (i = 0;  i < numCmds;  i++) {
-        if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
-            codeDeltaNext++;
-            delta = TclGetInt4AtPtr(codeDeltaNext);
-            codeDeltaNext += 4;
-        } else {
-            delta = TclGetInt1AtPtr(codeDeltaNext);
-            codeDeltaNext++;
-        }
-        codeOffset += delta;
-
-        if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
-            codeLengthNext++;
-            codeLen = TclGetInt4AtPtr(codeLengthNext);
-            codeLengthNext += 4;
-        } else {
-            codeLen = TclGetInt1AtPtr(codeLengthNext);
-            codeLengthNext++;
-        }
-        
-        if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
-            srcDeltaNext++;
-            delta = TclGetInt4AtPtr(srcDeltaNext);
-            srcDeltaNext += 4;
-        } else {
-            delta = TclGetInt1AtPtr(srcDeltaNext);
-            srcDeltaNext++;
-        }
-        srcOffset += delta;
-
-        if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
-            srcLengthNext++;
-            srcLen = TclGetInt4AtPtr(srcLengthNext);
-            srcLengthNext += 4;
-        } else {
-            srcLen = TclGetInt1AtPtr(srcLengthNext);
-            srcLengthNext++;
-        }
-        
-        fprintf(stdout, "%s%4d: pc %d-%d, source %d-%d",
-                ((i % 2)? "     " : "\n   "),
-                (i+1), codeOffset, (codeOffset + codeLen - 1),
-                srcOffset, (srcOffset + srcLen - 1));
-    }
-    if ((numCmds > 0) && ((numCmds % 2) != 0)) {
-        fprintf(stdout, "\n");
-    }
-    
-    /*
-     * Print each instruction. If the instruction corresponds to the start
-     * of a command, print the command's source. Note that we don't need
-     * the code length here.
-     */
-
-    codeDeltaNext = codePtr->codeDeltaStart;
-    srcDeltaNext  = codePtr->srcDeltaStart;
-    srcLengthNext = codePtr->srcLengthStart;
-    codeOffset = srcOffset = 0;
-    pc = codeStart;
-    for (i = 0;  i < numCmds;  i++) {
-        if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
-            codeDeltaNext++;
-            delta = TclGetInt4AtPtr(codeDeltaNext);
-            codeDeltaNext += 4;
-        } else {
-            delta = TclGetInt1AtPtr(codeDeltaNext);
-            codeDeltaNext++;
-        }
-        codeOffset += delta;
-
-        if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
-            srcDeltaNext++;
-            delta = TclGetInt4AtPtr(srcDeltaNext);
-            srcDeltaNext += 4;
-        } else {
-            delta = TclGetInt1AtPtr(srcDeltaNext);
-            srcDeltaNext++;
-        }
-        srcOffset += delta;
-
-        if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
-            srcLengthNext++;
-            srcLen = TclGetInt4AtPtr(srcLengthNext);
-            srcLengthNext += 4;
-        } else {
-            srcLen = TclGetInt1AtPtr(srcLengthNext);
-            srcLengthNext++;
-        }
-
-        /*
-         * Print instructions before command i.
-         */
-        
-        while ((pc-codeStart) < codeOffset) {
-            fprintf(stdout, "    ");
-            pc += TclPrintInstruction(codePtr, pc);
-        }
-
-        fprintf(stdout, "  Command %d: ", (i+1));
-        TclPrintSource(stdout, (codePtr->source + srcOffset),
-                TclMin(srcLen, 70));
-        fprintf(stdout, "\n");
-    }
-    if (pc < codeLimit) {
-        /*
-         * Print instructions after the last command.
-         */
-
-        while (pc < codeLimit) {
-            fprintf(stdout, "    ");
-            pc += TclPrintInstruction(codePtr, pc);
-        }
-    }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPrintInstruction --
- *
- *      This procedure prints ("disassembles") one instruction from a
- *      bytecode object to stdout.
- *
- * Results:
- *      Returns the length in bytes of the current instruiction.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclPrintInstruction(codePtr, pc)
-    ByteCode* codePtr;          /* Bytecode containing the instruction. */
-    unsigned char *pc;          /* Points to first byte of instruction. */
-{
-    Proc *procPtr = codePtr->procPtr;
-    unsigned char opCode = *pc;
-    register InstructionDesc *instDesc = &instructionTable[opCode];
-    unsigned char *codeStart = codePtr->codeStart;
-    unsigned int pcOffset = (pc - codeStart);
-    int opnd, elemLen, i, j;
-    Tcl_Obj *elemPtr;
-    char *string;
-    
-    fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
-    for (i = 0;  i < instDesc->numOperands;  i++) {
-        switch (instDesc->opTypes[i]) {
-        case OPERAND_INT1:
-            opnd = TclGetInt1AtPtr(pc+1+i);
-            if ((i == 0) && ((opCode == INST_JUMP1)
-                             || (opCode == INST_JUMP_TRUE1)
-                             || (opCode == INST_JUMP_FALSE1))) {
-                fprintf(stdout, "%d     # pc %u", opnd, (pcOffset + opnd));
-            } else {
-                fprintf(stdout, "%d", opnd);
-            }
-            break;
-        case OPERAND_INT4:
-            opnd = TclGetInt4AtPtr(pc+1+i);
-            if ((i == 0) && ((opCode == INST_JUMP4)
-                             || (opCode == INST_JUMP_TRUE4)
-                             || (opCode == INST_JUMP_FALSE4))) {
-                fprintf(stdout, "%d     # pc %u", opnd, (pcOffset + opnd));
-            } else {
-                fprintf(stdout, "%d", opnd);
-            }
-            break;
-        case OPERAND_UINT1:
-            opnd = TclGetUInt1AtPtr(pc+1+i);
-            if ((i == 0) && (opCode == INST_PUSH1)) {
-                elemPtr = codePtr->objArrayPtr[opnd];
-                string = Tcl_GetStringFromObj(elemPtr, &elemLen);
-                fprintf(stdout, "%u     # ", (unsigned int) opnd);
-                TclPrintSource(stdout, string, TclMin(elemLen, 40));
-            } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR1)
-                                    || (opCode == INST_LOAD_ARRAY1)
-                                    || (opCode == INST_STORE_SCALAR1)
-                                    || (opCode == INST_STORE_ARRAY1))) {
-                int localCt = procPtr->numCompiledLocals;
-                CompiledLocal *localPtr = procPtr->firstLocalPtr;
-                if (opnd >= localCt) {
-                    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
-                             (unsigned int) opnd, localCt);
-                    return instDesc->numBytes;
-                }
-                for (j = 0;  j < opnd;  j++) {
-                    localPtr = localPtr->nextPtr;
-                }
-                if (TclIsVarTemporary(localPtr)) {
-                    fprintf(stdout, "%u # temp var %u",
-                            (unsigned int) opnd, (unsigned int) opnd);
-                } else {
-                    fprintf(stdout, "%u # var ", (unsigned int) opnd);
-                    TclPrintSource(stdout, localPtr->name, 40);
-                }
-            } else {
-                fprintf(stdout, "%u ", (unsigned int) opnd);
-            }
-            break;
-        case OPERAND_UINT4:
-            opnd = TclGetUInt4AtPtr(pc+1+i);
-            if (opCode == INST_PUSH4) {
-                elemPtr = codePtr->objArrayPtr[opnd];
-                string = Tcl_GetStringFromObj(elemPtr, &elemLen);
-                fprintf(stdout, "%u     # ", opnd);
-                TclPrintSource(stdout, string, TclMin(elemLen, 40));
-            } else if ((i == 0) && ((opCode == INST_LOAD_SCALAR4)
-                                    || (opCode == INST_LOAD_ARRAY4)
-                                    || (opCode == INST_STORE_SCALAR4)
-                                    || (opCode == INST_STORE_ARRAY4))) {
-                int localCt = procPtr->numCompiledLocals;
-                CompiledLocal *localPtr = procPtr->firstLocalPtr;
-                if (opnd >= localCt) {
-                    panic("TclPrintInstruction: bad local var index %u (%u locals)\n",
-                             (unsigned int) opnd, localCt);
-                    return instDesc->numBytes;
-                }
-                for (j = 0;  j < opnd;  j++) {
-                    localPtr = localPtr->nextPtr;
-                }
-                if (TclIsVarTemporary(localPtr)) {
-                    fprintf(stdout, "%u # temp var %u",
-                            (unsigned int) opnd, (unsigned int) opnd);
-                } else {
-                    fprintf(stdout, "%u # var ", (unsigned int) opnd);
-                    TclPrintSource(stdout, localPtr->name, 40);
-                }
-            } else {
-                fprintf(stdout, "%u ", (unsigned int) opnd);
-            }
-            break;
-        case OPERAND_NONE:
-        default:
-            break;
-        }
-    }
-    fprintf(stdout, "\n");
-    return instDesc->numBytes;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
  * TclPrintSource --
  *
@@ -972 +537 @@
     register int i;
 
-#ifdef TCL_COMPILE_STATS    
-    tclCurrentSourceBytes -= (double) codePtr->numSrcChars;
-    tclCurrentCodeBytes -= (double) codePtr->totalSize;
-#endif /* TCL_COMPILE_STATS */
-
     /*
      * A single heap object holds the ByteCode structure and its code,
@@ -1067 +627 @@
     int length, result;
 
-    if (!traceInitialized) {
-        if (Tcl_LinkVar(interp, "tcl_traceCompile",
-                    (char *) &tclTraceCompile,  TCL_LINK_INT) != TCL_OK) {
-            panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
-        }
-        traceInitialized = 1;
-    }
-    
     string = Tcl_GetStringFromObj(objPtr, &length);
     TclInitCompileEnv(interp, &compEnv, string);
@@ -1113 +665 @@
     TclFreeCompileEnv(&compEnv);
 
-    if (result == TCL_OK) {
-        if (tclTraceCompile == 2) {
-            TclPrintByteCodeObj(interp, objPtr);
-        }
-    }
     return result;
 }
@@ -1311 +858 @@
     int numObjects, i;
     Namespace *namespacePtr;
-#ifdef TCL_COMPILE_STATS
-    int srcLenLog2, sizeLog2;
-#endif /*TCL_COMPILE_STATS*/
 
     codeBytes = (envPtr->codeNext - envPtr->codeStart);
@@ -1342 +886 @@
     }
     totalSize = (size + objBytes);
-
-#ifdef TCL_COMPILE_STATS
-    tclNumCompilations++;
-    tclTotalSourceBytes += (double) srcLen;
-    tclTotalCodeBytes += (double) totalSize;
-    
-    tclTotalInstBytes += (double) codeBytes;
-    tclTotalObjBytes += (double) objBytes;
-    tclTotalExceptBytes += exceptArrayBytes;
-    tclTotalAuxBytes += (double) auxDataArrayBytes;
-    tclTotalCmdMapBytes += (double) cmdLocBytes;
-
-    tclCurrentSourceBytes += (double) srcLen;
-    tclCurrentCodeBytes += (double) totalSize;
-
-    srcLenLog2 = TclLog2(srcLen);
-    sizeLog2 = TclLog2((int) totalSize);
-    if ((srcLenLog2 > 31) || (sizeLog2 > 31)) {
-        panic("TclInitByteCodeObj: bad source or code sizes\n");
-    }
-    tclSourceCount[srcLenLog2]++;
-    tclByteCodeCount[sizeLog2]++;
-#endif /* TCL_COMPILE_STATS */    
 
     if (envPtr->iPtr->varFramePtr != NULL) {
@@ -1820 +1341 @@
                 cmdCodeOffset);
             
-        if ((!(flags & TCL_BRACKET_TERM))
-                && (tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
-            /*
-             * Display a line summarizing the top level command we are about
-             * to compile.
-             */
-            
-            char *p = cmdSrcStart;
-            int numChars, complete;
-            
-            while ((CHAR_TYPE(p, lastChar) != TCL_COMMAND_END)
-                   || ((*p == ']') && !(flags & TCL_BRACKET_TERM))) {
-                p++;
-            }
-            numChars = (p - cmdSrcStart);
-            complete = 1;
-            if (numChars > 60) {
-                numChars = 60;
-                complete = 0;
-            } else if ((numChars >= 2) && (*p == '\n') && (*(p-1) == '{')) {
-                complete = 0;
-            }
-            fprintf(stdout, "Compiling: %.*s%s\n",
-                    numChars, cmdSrcStart, (complete? "" : " ..."));
-        }
-        
         while ((type != TCL_COMMAND_END)
                 || ((c == ']') && !(flags & TCL_BRACKET_TERM))) {

external/tcl/tclCompile.h

@@ -36 +36 @@
 
 extern Tcl_ObjType      tclCmdNameType;
-
-/*
- * Variable that controls whether compilation tracing is enabled and, if so,
- * what level of tracing is desired:
- *    0: no compilation tracing
- *    1: summarize compilation of top level cmds and proc bodies
- *    2: display all instructions of each ByteCode compiled
- * This variable is linked to the Tcl variable "tcl_traceCompile".
- */
-
-extern int              tclTraceCompile;
-
-/*
- * Variable that controls whether execution tracing is enabled and, if so,
- * what level of tracing is desired:
- *    0: no execution tracing
- *    1: trace invocations of Tcl procs only
- *    2: trace invocations of all (not compiled away) commands
- *    3: display each instruction executed
- * This variable is linked to the Tcl variable "tcl_traceExec".
- */
-
-extern int              tclTraceExec;
-
-/*
- * The number of bytecode compilations and various other compilation-related
- * statistics. The tclByteCodeCount and tclSourceCount arrays are used to
- * hold the count of ByteCodes and sources whose sizes fall into various
- * binary decades; e.g., tclByteCodeCount[5] is a count of the ByteCodes
- * with size larger than 2**4 and less than or equal to 2**5.
- */
-
-#ifdef TCL_COMPILE_STATS
-extern long             tclNumCompilations;
-extern double           tclTotalSourceBytes;
-extern double           tclTotalCodeBytes;
-
-extern double           tclTotalInstBytes;
-extern double           tclTotalObjBytes;
-extern double           tclTotalExceptBytes;
-extern double           tclTotalAuxBytes;
-extern double           tclTotalCmdMapBytes;
-
-extern double           tclCurrentSourceBytes;
-extern double           tclCurrentCodeBytes;
-
-extern int              tclSourceCount[32];
-extern int              tclByteCodeCount[32];
-#endif /* TCL_COMPILE_STATS */
 
 /*
@@ -816 +767 @@
 EXTERN void             TclInitJumpFixupArray _ANSI_ARGS_((
                             JumpFixupArray *fixupArrayPtr));
-#ifdef TCL_COMPILE_STATS
-EXTERN int              TclLog2 _ANSI_ARGS_((int value));
-#endif /*TCL_COMPILE_STATS*/
 EXTERN int              TclObjIndexForString _ANSI_ARGS_((char *start,
                             int length, int allocStrRep, int inHeap,
                             CompileEnv *envPtr));
-EXTERN int              TclPrintInstruction _ANSI_ARGS_((ByteCode* codePtr,
-                            unsigned char *pc));
 EXTERN void             TclPrintSource _ANSI_ARGS_((FILE *outFile,
                             char *string, int maxChars));

external/tcl/tclExecute.c

@@ -51 +51 @@
 
 /*
- * Variable that controls whether execution tracing is enabled and, if so,
- * what level of tracing is desired:
- *    0: no execution tracing
- *    1: trace invocations of Tcl procs only
- *    2: trace invocations of all (not compiled away) commands
- *    3: display each instruction executed
- * This variable is linked to the Tcl variable "tcl_traceExec".
- */
-
-int tclTraceExec = 0;
-
-/*
  * The following global variable is use to signal matherr that Tcl
  * is responsible for the arithmetic, so errors can be handled in a
@@ -102 +90 @@
 };
     
-/*
- * Mapping from Tcl result codes to strings; used for error and debugging
- * messages. 
- */
-
-#ifdef TCL_COMPILE_DEBUG
-static char *resultStrings[] = {
-    "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
-};
-#endif /* TCL_COMPILE_DEBUG */
-
-/*
- * The following are statistics-related variables that record information
- * about the bytecode compiler and interpreter's operation. This includes
- * an array that records for each instruction how often it is executed.
- */
-
-#ifdef TCL_COMPILE_STATS
-static long numExecutions = 0;
-static int instructionCount[256];
-#endif /* TCL_COMPILE_STATS */
-
 /*
  * Macros for testing floating-point values for certain special cases. Test
@@ -187 +153 @@
 #define POP_OBJECT() \
     (stackPtr[stackTop--].o)
-
-/*
- * Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclExecuteByteCode.
- * O2S is only used in TRACE* calls to get a string from an object.
- * 
- * NOTE THAT CLIENTS OF O2S ARE LIKELY TO FAIL IF THE OBJECT'S
- * STRING REP CONTAINS NULLS. 
- */
-
-#ifdef TCL_COMPILE_DEBUG
-        
-#define O2S(objPtr) \
-    Tcl_GetStringFromObj((objPtr), &length)
-        
-#ifdef TCL_COMPILE_STATS
-#define TRACE(a) \
-    if (traceInstructions) { \
-        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
-               stackTop, (tclObjsAlloced - tclObjsFreed), \
-               (unsigned int)(pc - codePtr->codeStart)); \
-        printf a; \
-        fflush(stdout); \
-    }
-#define TRACE_WITH_OBJ(a, objPtr) \
-    if (traceInstructions) { \
-        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
-               stackTop, (tclObjsAlloced - tclObjsFreed), \
-               (unsigned int)(pc - codePtr->codeStart)); \
-        printf a; \
-        bytes = Tcl_GetStringFromObj((objPtr), &length); \
-        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
-        fprintf(stdout, "\n"); \
-        fflush(stdout); \
-    }
-#else  /* not TCL_COMPILE_STATS */
-#define TRACE(a) \
-    if (traceInstructions) { \
-        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
-               (unsigned int)(pc - codePtr->codeStart)); \
-        printf a; \
-        fflush(stdout); \
-    }
-#define TRACE_WITH_OBJ(a, objPtr) \
-    if (traceInstructions) { \
-        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
-               (unsigned int)(pc - codePtr->codeStart)); \
-        printf a; \
-        bytes = Tcl_GetStringFromObj((objPtr), &length); \
-        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
-        fprintf(stdout, "\n"); \
-        fflush(stdout); \
-    }
-#endif /* TCL_COMPILE_STATS */
-
-#else  /* not TCL_COMPILE_DEBUG */
-        
-#define TRACE(a)
-#define TRACE_WITH_OBJ(a, objPtr)
-#define O2S(objPtr)
-        
-#endif /* TCL_COMPILE_DEBUG */
 
 /*
@@ -274 +178 @@
 static int              ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
                             ExecEnv *eePtr, ClientData clientData));
-#ifdef TCL_COMPILE_STATS
-static int              EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
-                            Tcl_Interp *interp, int argc, char **argv));
-#endif /* TCL_COMPILE_STATS */
 static void             FreeCmdNameInternalRep _ANSI_ARGS_((
                             Tcl_Obj *objPtr));
@@ -293 +193 @@
 static int              SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
                             Tcl_Obj *objPtr));
-#ifdef TCL_COMPILE_DEBUG
-static char *           StringForResultCode _ANSI_ARGS_((int result));
-#endif /* TCL_COMPILE_DEBUG */
 static void             UpdateStringOfCmdName _ANSI_ARGS_((Tcl_Obj *objPtr));
-#ifdef TCL_COMPILE_DEBUG
-static void             ValidatePcAndStackTop _ANSI_ARGS_((
-                            ByteCode *codePtr, unsigned char *pc,
-                            int stackTop, int stackLowerBound,
-                            int stackUpperBound));
-#endif /* TCL_COMPILE_DEBUG */
 
 /*
@@ -368 +259 @@
  *
  * Side effects:
- *      This procedure initializes the array of instruction names. If
- *      compiling with the TCL_COMPILE_STATS flag, it initializes the
- *      array that counts the executions of each instruction and it
- *      creates the "evalstats" command. It also registers the command name
- *      Tcl_ObjType. It also establishes the link between the Tcl
- *      "tcl_traceExec" and C "tclTraceExec" variables.
+ *      This procedure initializes the array of instruction names.
  *
  *----------------------------------------------------------------------
@@ -391 +277 @@
     for (i = 0;  instructionTable[i].name != NULL;  i++) {
         opName[i] = instructionTable[i].name;
-    }
-
-#ifdef TCL_COMPILE_STATS    
-    (VOID *) memset(instructionCount, 0, sizeof(instructionCount));
-    (VOID *) memset(tclByteCodeCount, 0, sizeof(tclByteCodeCount));
-    (VOID *) memset(tclSourceCount, 0, sizeof(tclSourceCount));
-
-    Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd,
-                      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
-#endif /* TCL_COMPILE_STATS */
-    
-    if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
-                    TCL_LINK_INT) != TCL_OK) {
-        panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
     }
 }
@@ -598 +470 @@
                                  * process break, continue, and errors. */
     int result = TCL_OK;        /* Return code returned after execution. */
-    int traceInstructions = (tclTraceExec == 3);
     Tcl_Obj *valuePtr, *value2Ptr, *namePtr, *objPtr;
     char *bytes;
     int length;
     long i;
-    Tcl_DString command;        /* Used for debugging. If tclTraceExec >= 2
-                                 * holds a string representing the last
-                                 * command invoked. */
 
     /*
@@ -620 +488 @@
 
     /*
-     * THIS PROC FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
-     */
-
-    if (tclTraceExec >= 2) {
-        PrintByteCodeInfo(codePtr);
-#ifdef TCL_COMPILE_STATS
-        fprintf(stdout, "  Starting stack top=%d, system objects=%ld\n",
-                eePtr->stackTop, (tclObjsAlloced - tclObjsFreed));
-#else
-        fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
-#endif /* TCL_COMPILE_STATS */
-        fflush(stdout);
-    }
-
-#ifdef TCL_COMPILE_STATS
-    numExecutions++;
-#endif /* TCL_COMPILE_STATS */
-
-    /*
      * Make sure the catch stack is large enough to hold the maximum number
      * of catch commands that could ever be executing at the same time. This
@@ -659 +508 @@
 
     /*
-     * Initialize the buffer that holds a string containing the name and
-     * arguments for the last invoked command.
-     */
-
-    Tcl_DStringInit(&command);
-
-    /*
      * Loop executing instructions until a "done" instruction, a TCL_RETURN,
      * or some error.
@@ -671 +513 @@
 
     for (;;) {
-#ifdef TCL_COMPILE_DEBUG
-        ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
-                eePtr->stackEnd);
-#else /* not TCL_COMPILE_DEBUG */
-        if (traceInstructions) {
-#ifdef TCL_COMPILE_STATS
-            fprintf(stdout, "%d: %d,%ld ", iPtr->numLevels, stackTop,
-                    (tclObjsAlloced - tclObjsFreed));
-#else /* TCL_COMPILE_STATS */
-            fprintf(stdout, "%d: %d ", iPtr->numLevels, stackTop);
-#endif /* TCL_COMPILE_STATS */
-            TclPrintInstruction(codePtr, pc);
-            fflush(stdout);
-        }
-#endif /* TCL_COMPILE_DEBUG */
-        
         opCode = *pc;
-#ifdef TCL_COMPILE_STATS    
-        instructionCount[opCode]++;
-#endif /* TCL_COMPILE_STATS */
 
         switch (opCode) {
@@ -710 +533 @@
                 panic("TclExecuteByteCode execution failure: end stack top != start stack top");
             }
-            TRACE_WITH_OBJ(("done => return code=%d, result is ", result),
-                    iPtr->objResultPtr);
             goto done;
             
@@ -717 +538 @@
             valuePtr = objArrayPtr[TclGetUInt1AtPtr(pc+1)];
             PUSH_OBJECT(valuePtr);
-            TRACE_WITH_OBJ(("push1 %u => ", TclGetUInt1AtPtr(pc+1)),
-                    valuePtr);
             ADJUST_PC(2);
             
@@ -724 +543 @@
             valuePtr = objArrayPtr[TclGetUInt4AtPtr(pc+1)];
             PUSH_OBJECT(valuePtr);
-            TRACE_WITH_OBJ(("push4 %u => ", TclGetUInt4AtPtr(pc+1)),
-                    valuePtr);
             ADJUST_PC(5);
             
         case INST_POP:
             valuePtr = POP_OBJECT();
-            TRACE_WITH_OBJ(("pop => discarding "), valuePtr);
             TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
             ADJUST_PC(1);
@@ -737 +553 @@
             valuePtr = stackPtr[stackTop].o;
             PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
-            TRACE_WITH_OBJ(("dup => "), valuePtr);
             ADJUST_PC(1);
 
@@ -790 +605 @@
                 
                 PUSH_OBJECT(concatObjPtr);
-                TRACE_WITH_OBJ(("concat %u => ", opnd), concatObjPtr);
                 ADJUST_PC(2);
             }
@@ -815 +629 @@
                                     * Init. to avoid compiler warning. */
                 Tcl_Command cmd;
-#ifdef TCL_COMPILE_DEBUG
-                int isUnknownCmd = 0;
-                char cmdNameBuf[30];
-#endif /* TCL_COMPILE_DEBUG */
                 
                 /*
@@ -867 +677 @@
                                 "invalid command name \"", cmdName, "\"",
                                 (char *) NULL);
-                        TRACE(("%s %u => unknown proc not found: ",
-                               opName[opCode], objc));
                         result = TCL_ERROR;
                         goto checkForCatch;
                     }
                     cmdPtr = (Command *) cmd;
-#ifdef TCL_COMPILE_DEBUG
-                    isUnknownCmd = 1;
-#endif /*TCL_COMPILE_DEBUG*/                    
                     stackTop++; /* need room for new inserted objv[0] */
                     for (i = objc;  i >= 0;  i--) {
@@ -918 +723 @@
                 Tcl_ResetResult(interp);
 
-                if (tclTraceExec >= 2) {
-                    char buffer[50];
-
-                    sprintf(buffer, "%d: (%u) invoking ", iPtr->numLevels,
-                            (unsigned int)(pc - codePtr->codeStart));
-                    Tcl_DStringAppend(&command, buffer, -1);
-                    
-#ifdef TCL_COMPILE_DEBUG
-                    if (traceInstructions) { /* tclTraceExec == 3 */
-                        strncpy(cmdNameBuf, cmdName, 20);
-                        TRACE(("%s %u => call ", opName[opCode],
-                               (isUnknownCmd? objc-1 : objc)));
-                    } else {
-                        fprintf(stdout, "%s", buffer);
-                    }
-#else /* TCL_COMPILE_DEBUG */
-                    fprintf(stdout, "%s", buffer);
-#endif /*TCL_COMPILE_DEBUG*/
-
-                    for (i = 0;  i < objc;  i++) {
-                        bytes = TclGetStringFromObj(objv[i], &length);
-                        TclPrintSource(stdout, bytes, TclMin(length, 15));
-                        fprintf(stdout, " ");
-
-                        sprintf(buffer, "\"%.*s\" ", TclMin(length, 15), bytes);
-                        Tcl_DStringAppend(&command, buffer, -1);
-                    }
-                    fprintf(stdout, "\n");
-                    fflush(stdout);
-
-                    Tcl_DStringFree(&command);
-                }
-
                 iPtr->cmdCount++;
                 DECACHE_STACK_INFO();
@@ -996 +768 @@
                      */
                     PUSH_OBJECT(Tcl_GetObjResult(interp));
-                    TRACE_WITH_OBJ(("%s %u => ...after \"%.20s\", result=",
-                            opName[opCode], objc, cmdNameBuf),
-                            Tcl_GetObjResult(interp));
                     ADJUST_PC(pcAdjustment);
                     
@@ -1015 +784 @@
                             /*catchOnly*/ 0, codePtr);
                     if (rangePtr == NULL) {
-                        TRACE(("%s %u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
-                                opName[opCode], objc, cmdNameBuf,
-                                StringForResultCode(result)));
                         goto abnormalReturn; /* no catch exists to check */
                     }
@@ -1025 +791 @@
                             newPcOffset = rangePtr->breakOffset;
                         } else if (rangePtr->continueOffset == -1) {
-                            TRACE(("%s %u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
-                                   opName[opCode], objc, cmdNameBuf,
-                                   StringForResultCode(result)));
                             goto checkForCatch;
                         } else {
                             newPcOffset = rangePtr->continueOffset;
                         }
-                        TRACE(("%s %u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
-                               opName[opCode], objc, cmdNameBuf,
-                               StringForResultCode(result),
-                               rangePtr->codeOffset, newPcOffset));
                         break;
                     case CATCH_EXCEPTION_RANGE:
-                        TRACE(("%s %u => ... after \"%.20s\", %s...\n",
-                               opName[opCode], objc, cmdNameBuf,
-                               StringForResultCode(result)));
                         goto processCatch; /* it will use rangePtr */
                     default:
@@ -1054 +810 @@
                      * enclosing catch exception range, if any.
                      */
-                    TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", TCL_ERROR ",
-                            opName[opCode], objc, cmdNameBuf),
-                            Tcl_GetObjResult(interp));
                     goto checkForCatch;
 
@@ -1065 +818 @@
                      * for an enclosing catch exception range, if any.
                      */
-                    TRACE(("%s %u => ... after \"%.20s\", TCL_RETURN\n",
-                            opName[opCode], objc, cmdNameBuf));
                     goto checkForCatch;
 
                 default:
-                    TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", OTHER RETURN CODE %d ",
-                            opName[opCode], objc, cmdNameBuf, result),
-                            Tcl_GetObjResult(interp));
                     goto checkForCatch;
                 } /* end of switch on result from invoke instruction */
@@ -1088 +836 @@
                 
                 PUSH_OBJECT(Tcl_GetObjResult(interp));
-                TRACE_WITH_OBJ(("evalStk \"%.30s\" => ", O2S(objPtr)),
-                        Tcl_GetObjResult(interp));
                 TclDecrRefCount(objPtr);
                 ADJUST_PC(1);
@@ -1109 +855 @@
                         codePtr);
                 if (rangePtr == NULL) {
-                    TRACE(("evalStk \"%.30s\" => no encl. loop or catch, returning %s\n",
-                            O2S(objPtr), StringForResultCode(result)));
                     Tcl_DecrRefCount(objPtr);
                     goto abnormalReturn;    /* no catch exists to check */
@@ -1119 +863 @@
                         newPcOffset = rangePtr->breakOffset;
                     } else if (rangePtr->continueOffset == -1) {
-                        TRACE(("evalStk \"%.30s\" => %s, loop w/o continue, checking for catch\n",
-                               O2S(objPtr), StringForResultCode(result)));
                         Tcl_DecrRefCount(objPtr);
                         goto checkForCatch;
@@ -1127 +869 @@
                     }
                     result = TCL_OK;
-                    TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s, range at %d, new pc %d ",
-                            O2S(objPtr), StringForResultCode(result),
-                            rangePtr->codeOffset, newPcOffset), valuePtr);
                     break;
                 case CATCH_EXCEPTION_RANGE:
-                    TRACE_WITH_OBJ(("evalStk \"%.30s\" => %s ",
-                            O2S(objPtr), StringForResultCode(result)),
-                            valuePtr);
                     Tcl_DecrRefCount(objPtr);
                     goto processCatch;  /* it will use rangePtr */
@@ -1144 +880 @@
                 continue;       /* restart outer instruction loop at pc */
             } else { /* eval returned TCL_ERROR, TCL_RETURN, unknown code */
-                TRACE_WITH_OBJ(("evalStk \"%.30s\" => ERROR: ", O2S(objPtr)),
-                        Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(objPtr);
                 goto checkForCatch;
@@ -1157 +891 @@
             CACHE_STACK_INFO();
             if (result != TCL_OK) {
-                TRACE_WITH_OBJ(("exprStk \"%.30s\" => ERROR: ", 
-                        O2S(objPtr)), Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(objPtr);
                 goto checkForCatch;
             }
             stackPtr[++stackTop].o = valuePtr; /* already has right refct */
-            TRACE_WITH_OBJ(("exprStk \"%.30s\" => ", O2S(objPtr)), valuePtr);
             TclDecrRefCount(objPtr);
             ADJUST_PC(1);
@@ -1182 +913 @@
             CACHE_STACK_INFO();
             if (valuePtr == NULL) {
-                TRACE_WITH_OBJ(("%s %u => ERROR: ", opName[opCode], opnd),
-                        Tcl_GetObjResult(interp));
                 result = TCL_ERROR;
                 goto checkForCatch;
             }
             PUSH_OBJECT(valuePtr);
-            TRACE_WITH_OBJ(("%s %u => ", opName[opCode], opnd), valuePtr);
             ADJUST_PC(pcAdjustment);
 
@@ -1198 +926 @@
             CACHE_STACK_INFO();
             if (valuePtr == NULL) {
-                TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ERROR: ",
-                        O2S(namePtr)), Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(namePtr);
                 result = TCL_ERROR;
@@ -1205 +931 @@
             }
             PUSH_OBJECT(valuePtr);
-            TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ",
-                    O2S(namePtr)), valuePtr);
             TclDecrRefCount(namePtr);
             ADJUST_PC(1);
@@ -1228 +952 @@
                 CACHE_STACK_INFO();
                 if (valuePtr == NULL) {
-                    TRACE_WITH_OBJ(("%s %u \"%.30s\" => ERROR: ",
-                            opName[opCode], opnd, O2S(elemPtr)),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(elemPtr);
                     result = TCL_ERROR;
@@ -1236 +957 @@
                 }
                 PUSH_OBJECT(valuePtr);
-                TRACE_WITH_OBJ(("%s %u \"%.30s\" => ",
-                        opName[opCode], opnd, O2S(elemPtr)), valuePtr);
                 TclDecrRefCount(elemPtr);
             }
@@ -1252 +971 @@
                 CACHE_STACK_INFO();
                 if (valuePtr == NULL) {
-                    TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ERROR: ",
-                            O2S(namePtr), O2S(elemPtr)),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(namePtr);
                     Tcl_DecrRefCount(elemPtr);
@@ -1261 +977 @@
                 }
                 PUSH_OBJECT(valuePtr);
-                TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ",
-                        O2S(namePtr), O2S(elemPtr)), valuePtr);
                 TclDecrRefCount(namePtr);
                 TclDecrRefCount(elemPtr);
@@ -1275 +989 @@
             CACHE_STACK_INFO();
             if (valuePtr == NULL) {
-                TRACE_WITH_OBJ(("loadStk \"%.30s\" => ERROR: ",
-                        O2S(namePtr)), Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(namePtr);
                 result = TCL_ERROR;
@@ -1282 +994 @@
             }
             PUSH_OBJECT(valuePtr);
-            TRACE_WITH_OBJ(("loadStk \"%.30s\" => ", O2S(namePtr)),
-                    valuePtr);
             TclDecrRefCount(namePtr);
             ADJUST_PC(1);
@@ -1303 +1013 @@
             CACHE_STACK_INFO();
             if (value2Ptr == NULL) {
-                TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ERROR: ",
-                        opName[opCode], opnd, O2S(valuePtr)),
-                        Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(valuePtr);
                 result = TCL_ERROR;
@@ -1311 +1018 @@
             }
             PUSH_OBJECT(value2Ptr);
-            TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ",
-                    opName[opCode], opnd, O2S(valuePtr)), value2Ptr);
             TclDecrRefCount(valuePtr);
             ADJUST_PC(pcAdjustment);
@@ -1324 +1029 @@
             CACHE_STACK_INFO();
             if (value2Ptr == NULL) {
-                TRACE_WITH_OBJ(
-                        ("storeScalarStk \"%.30s\" <- \"%.30s\" => ERROR: ",
-                        O2S(namePtr), O2S(valuePtr)),
-                        Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(namePtr);
                 Tcl_DecrRefCount(valuePtr);
@@ -1334 +1035 @@
             }
             PUSH_OBJECT(value2Ptr);
-            TRACE_WITH_OBJ(
-                    ("storeScalarStk \"%.30s\" <- \"%.30s\" => ",
-                    O2S(namePtr),
-                    O2S(valuePtr)),
-                    value2Ptr);
             TclDecrRefCount(namePtr);
             TclDecrRefCount(valuePtr);
@@ -1363 +1059 @@
                 CACHE_STACK_INFO();
                 if (value2Ptr == NULL) {
-                    TRACE_WITH_OBJ(
-                            ("%s %u \"%.30s\" <- \"%.30s\" => ERROR: ",
-                            opName[opCode], opnd, O2S(elemPtr),
-                            O2S(valuePtr)), Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(elemPtr);
                     Tcl_DecrRefCount(valuePtr);
@@ -1373 +1065 @@
                 }
                 PUSH_OBJECT(value2Ptr);
-                TRACE_WITH_OBJ(("%s %u \"%.30s\" <- \"%.30s\" => ",
-                        opName[opCode], opnd, O2S(elemPtr), O2S(valuePtr)),
-                        value2Ptr);
                 TclDecrRefCount(elemPtr);
                 TclDecrRefCount(valuePtr);
@@ -1393 +1082 @@
                 CACHE_STACK_INFO();
                 if (value2Ptr == NULL) {
-                    TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
-                            O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(namePtr);
                     Tcl_DecrRefCount(elemPtr);
@@ -1403 +1089 @@
                 }
                 PUSH_OBJECT(value2Ptr);
-                TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ",
-                        O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
-                        value2Ptr);
                 TclDecrRefCount(namePtr);
                 TclDecrRefCount(elemPtr);
@@ -1420 +1103 @@
             CACHE_STACK_INFO();
             if (value2Ptr == NULL) {
-                TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ERROR: ",
-                        O2S(namePtr), O2S(valuePtr)),
-                        Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(namePtr);
                 Tcl_DecrRefCount(valuePtr);
@@ -1429 +1109 @@
             }
             PUSH_OBJECT(value2Ptr);
-            TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ",
-                    O2S(namePtr), O2S(valuePtr)), value2Ptr);
             TclDecrRefCount(namePtr);
             TclDecrRefCount(valuePtr);
@@ -1441 +1119 @@
                 result = tclIntType.setFromAnyProc(interp, valuePtr);
                 if (result != TCL_OK) {
-                    TRACE_WITH_OBJ(("incrScalar1 %u (by %s) => ERROR converting increment amount to int: ",
-                            opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(valuePtr);
                     goto checkForCatch;
@@ -1452 +1128 @@
             CACHE_STACK_INFO();
             if (value2Ptr == NULL) {
-                TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ERROR: ",
-                        opnd, i), Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(valuePtr);
                 result = TCL_ERROR;
@@ -1459 +1133 @@
             }
             PUSH_OBJECT(value2Ptr);
-            TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ", opnd, i),
-                    value2Ptr);
             TclDecrRefCount(valuePtr);
             ADJUST_PC(2);
@@ -1471 +1143 @@
                 result = tclIntType.setFromAnyProc(interp, valuePtr);
                 if (result != TCL_OK) {
-                    TRACE_WITH_OBJ(("%s \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
-                            opName[opCode], O2S(namePtr), O2S(valuePtr)),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(namePtr);
                     Tcl_DecrRefCount(valuePtr);
@@ -1485 +1154 @@
             CACHE_STACK_INFO();
             if (value2Ptr == NULL) {
-                TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ERROR: ",
-                        opName[opCode], O2S(namePtr), i),
-                        Tcl_GetObjResult(interp));
                 Tcl_DecrRefCount(namePtr);
                 Tcl_DecrRefCount(valuePtr);
@@ -1494 +1160 @@
             }
             PUSH_OBJECT(value2Ptr);
-            TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ",
-                    opName[opCode], O2S(namePtr), i), value2Ptr);
             Tcl_DecrRefCount(namePtr);
             Tcl_DecrRefCount(valuePtr);
@@ -1510 +1174 @@
                     result = tclIntType.setFromAnyProc(interp, valuePtr);
                     if (result != TCL_OK) {
-                        TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
-                                opnd, O2S(elemPtr), O2S(valuePtr)),
-                                Tcl_GetObjResult(interp));
                         Tcl_DecrRefCount(elemPtr);
                         Tcl_DecrRefCount(valuePtr);
@@ -1524 +1185 @@
                 CACHE_STACK_INFO();
                 if (value2Ptr == NULL) {
-                    TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ERROR: ",
-                            opnd, O2S(elemPtr), i),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(elemPtr);
                     Tcl_DecrRefCount(valuePtr);
@@ -1533 +1191 @@
                 }
                 PUSH_OBJECT(value2Ptr);
-                TRACE_WITH_OBJ(("incrArray1 %u \"%.30s\" (by %ld) => ",
-                        opnd, O2S(elemPtr), i), value2Ptr);
                 Tcl_DecrRefCount(elemPtr);
                 Tcl_DecrRefCount(valuePtr);
@@ -1550 +1206 @@
                     result = tclIntType.setFromAnyProc(interp, valuePtr);
                     if (result != TCL_OK) {
-                        TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
-                                O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
-                                Tcl_GetObjResult(interp));
                         Tcl_DecrRefCount(namePtr);
                         Tcl_DecrRefCount(elemPtr);
@@ -1565 +1218 @@
                 CACHE_STACK_INFO();
                 if (value2Ptr == NULL) {
-                    TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ERROR: ",
-                            O2S(namePtr), O2S(elemPtr), i),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(namePtr);
                     Tcl_DecrRefCount(elemPtr);
@@ -1575 +1225 @@
                 }
                 PUSH_OBJECT(value2Ptr);
-                TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ",
-                        O2S(namePtr), O2S(elemPtr), i), value2Ptr);
                 Tcl_DecrRefCount(namePtr);
                 Tcl_DecrRefCount(elemPtr);
@@ -1590 +1238 @@
             CACHE_STACK_INFO();
             if (value2Ptr == NULL) {
-                TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ERROR: ",
-                        opnd, i), Tcl_GetObjResult(interp));
                 result = TCL_ERROR;
                 goto checkForCatch;
             }
             PUSH_OBJECT(value2Ptr);
-            TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ", opnd, i),
-                    value2Ptr);
             ADJUST_PC(3);
 
@@ -1609 +1253 @@
             CACHE_STACK_INFO();
             if (value2Ptr == NULL) {
-                TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ERROR: ",
-                        opName[opCode], O2S(namePtr), i),
-                        Tcl_GetObjResult(interp));
                 result = TCL_ERROR;
                 Tcl_DecrRefCount(namePtr);
@@ -1617 +1258 @@
             }
             PUSH_OBJECT(value2Ptr);
-            TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ",
-                    opName[opCode], O2S(namePtr), i), value2Ptr);
             TclDecrRefCount(namePtr);
             ADJUST_PC(2);
@@ -1634 +1273 @@
                 CACHE_STACK_INFO();
                 if (value2Ptr == NULL) {
-                    TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ERROR: ",
-                            opnd, O2S(elemPtr), i),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(elemPtr);
                     result = TCL_ERROR;
@@ -1642 +1278 @@
                 }
                 PUSH_OBJECT(value2Ptr);
-                TRACE_WITH_OBJ(("incrArray1Imm %u \"%.30s\" (by %ld) => ",
-                        opnd, O2S(elemPtr), i), value2Ptr);
                 Tcl_DecrRefCount(elemPtr);
             }
@@ -1660 +1294 @@
                 CACHE_STACK_INFO();
                 if (value2Ptr == NULL) {
-                    TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ERROR: ",
-                            O2S(namePtr), O2S(elemPtr), i),
-                            Tcl_GetObjResult(interp));
                     Tcl_DecrRefCount(namePtr);
                     Tcl_DecrRefCount(elemPtr);
@@ -1669 +1300 @@
                 }
                 PUSH_OBJECT(value2Ptr);
-                TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ",
-                        O2S(namePtr), O2S(elemPtr), i), value2Ptr);
                 Tcl_DecrRefCount(namePtr);
                 Tcl_DecrRefCount(elemPtr);
@@ -1678 +1307 @@
         case INST_JUMP1:
             opnd = TclGetInt1AtPtr(pc+1);
-            TRACE(("jump1 %d => new pc %u\n", opnd,
-                   (unsigned int)(pc + opnd - codePtr->codeStart)));
             ADJUST_PC(opnd);
 
         case INST_JUMP4:
             opnd = TclGetInt4AtPtr(pc+1);
-            TRACE(("jump4 %d => new pc %u\n", opnd,
-                   (unsigned int)(pc + opnd - codePtr->codeStart)));
             ADJUST_PC(opnd);
 
@@ -1709 +1334 @@
                     result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
                     if (result != TCL_OK) {
-                        TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
-                                opnd), Tcl_GetObjResult(interp));
                         Tcl_DecrRefCount(valuePtr);
                         goto checkForCatch;
@@ -1716 +1339 @@
                 }
                 if (b) {
-                    TRACE(("%s %d => %.20s true, new pc %u\n",
-                            opName[opCode], opnd, O2S(valuePtr),
-                            (unsigned int)(pc+opnd - codePtr->codeStart)));
                     TclDecrRefCount(valuePtr);
                     ADJUST_PC(opnd);
                 } else {
-                    TRACE(("%s %d => %.20s false\n", opName[opCode], opnd,
-                            O2S(valuePtr)));
                     TclDecrRefCount(valuePtr);
                     ADJUST_PC(pcAdjustment);
@@ -1750 +1368 @@
                     result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
                     if (result != TCL_OK) {
-                        TRACE_WITH_OBJ(("%s %d => ERROR: ", opName[opCode],
-                                opnd), Tcl_GetObjResult(interp));
                         Tcl_DecrRefCount(valuePtr);
                         goto checkForCatch;
@@ -1757 +1373 @@
                 }
                 if (b) {
-                    TRACE(("%s %d => %.20s true\n", opName[opCode], opnd,
-                            O2S(valuePtr)));
                     TclDecrRefCount(valuePtr);
                     ADJUST_PC(pcAdjustment);
                 } else {
-                    TRACE(("%s %d => %.20s false, new pc %u\n",
-                            opName[opCode], opnd, O2S(valuePtr),
-                           (unsigned int)(pc + opnd - codePtr->codeStart)));
                     TclDecrRefCount(valuePtr);
                     ADJUST_PC(opnd);
@@ -1804 +1415 @@
                     }
                     if (result != TCL_OK) {
-                        TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
-                                opName[opCode], O2S(valuePtr),
-                                (t1Ptr? t1Ptr->name : "null")));
                         IllegalExprOperandType(interp, opCode, valuePtr);
                         Tcl_DecrRefCount(valuePtr);
@@ -1830 +1438 @@
                     }
                     if (result != TCL_OK) {
-                        TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
-                                opName[opCode], O2S(value2Ptr),
-                                (t2Ptr? t2Ptr->name : "null")));
                         IllegalExprOperandType(interp, opCode, value2Ptr);
                         Tcl_DecrRefCount(valuePtr);
@@ -1851 +1456 @@
                 if (Tcl_IsShared(valuePtr)) {
                     PUSH_OBJECT(Tcl_NewLongObj(iResult));
-                    TRACE(("%s %.20s %.20s => %d\n", opName[opCode],
-                           O2S(valuePtr), O2S(value2Ptr), iResult));
                     TclDecrRefCount(valuePtr);
                 } else {        /* reuse the valuePtr object */
-                    TRACE(("%s %.20s %.20s => %d\n", 
-                           opName[opCode], /* NB: stack top is off by 1 */
-                           O2S(valuePtr), O2S(value2Ptr), iResult));
                     Tcl_SetLongObj(valuePtr, iResult);
                     ++stackTop; /* valuePtr now on stk top has right r.c. */
@@ -2013 +1613 @@
                 if (Tcl_IsShared(valuePtr)) {
                     PUSH_OBJECT(Tcl_NewLongObj(iResult));
-                    TRACE(("%s %.20s %.20s => %ld\n", opName[opCode],
-                        O2S(valuePtr), O2S(value2Ptr), iResult));
                     TclDecrRefCount(valuePtr);
                 } else {        /* reuse the valuePtr object */
-                    TRACE(("%s %.20s %.20s => %ld\n",
-                        opName[opCode], /* NB: stack top is off by 1 */
-                        O2S(valuePtr), O2S(value2Ptr), iResult));
                     Tcl_SetLongObj(valuePtr, iResult);
                     ++stackTop; /* valuePtr now on stk top has right r.c. */
@@ -2049 +1644 @@
                             valuePtr, &i);
                     if (result != TCL_OK) {
-                        TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
-                              opName[opCode], O2S(valuePtr), O2S(value2Ptr),
-                              (valuePtr->typePtr?
-                                   valuePtr->typePtr->name : "null")));
                         IllegalExprOperandType(interp, opCode, valuePtr);
                         Tcl_DecrRefCount(valuePtr);
@@ -2065 +1656 @@
                             value2Ptr, &i2);
                     if (result != TCL_OK) {
-                        TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
-                              opName[opCode], O2S(valuePtr), O2S(value2Ptr),
-                              (value2Ptr->typePtr?
-                                   value2Ptr->typePtr->name : "null")));
                         IllegalExprOperandType(interp, opCode, value2Ptr);
                         Tcl_DecrRefCount(valuePtr);
@@ -2085 +1672 @@
                      */
                     if (i2 == 0) {
-                        TRACE(("mod %ld %ld => DIVIDE BY ZERO\n", i, i2));
                         Tcl_DecrRefCount(valuePtr);
                         Tcl_DecrRefCount(value2Ptr);
@@ -2137 +1723 @@
                 if (Tcl_IsShared(valuePtr)) {
                     PUSH_OBJECT(Tcl_NewLongObj(iResult));
-                    TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
-                           iResult));
                     TclDecrRefCount(valuePtr);
                 } else {        /* reuse the valuePtr object */
-                    TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
-                        iResult)); /* NB: stack top is off by 1 */
                     Tcl_SetLongObj(valuePtr, iResult);
                     ++stackTop; /* valuePtr now on stk top has right r.c. */
@@ -2186 +1768 @@
                     }
                     if (result != TCL_OK) {
-                        TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
-                               opName[opCode], s, O2S(value2Ptr),
-                               (valuePtr->typePtr?
-                                    valuePtr->typePtr->name : "null")));
                         IllegalExprOperandType(interp, opCode, valuePtr);
                         Tcl_DecrRefCount(valuePtr);
@@ -2212 +1790 @@
                     }
                     if (result != TCL_OK) {
-                        TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
-                               opName[opCode], O2S(valuePtr), s,
-                               (value2Ptr->typePtr?
-                                    value2Ptr->typePtr->name : "null")));
                         IllegalExprOperandType(interp, opCode, value2Ptr);
                         Tcl_DecrRefCount(valuePtr);
@@ -2246 +1820 @@
                     case INST_DIV:
                         if (d2 == 0.0) {
-                            TRACE(("div %.6g %.6g => DIVIDE BY ZERO\n",
-                                   d1, d2));
                             Tcl_DecrRefCount(valuePtr);
                             Tcl_DecrRefCount(value2Ptr);
@@ -2261 +1833 @@
                     
                     if (IS_NAN(dResult) || IS_INF(dResult)) {
-                        TRACE(("%s %.20s %.20s => IEEE FLOATING PT ERROR\n",
-                               opName[opCode], O2S(valuePtr), O2S(value2Ptr)));
                         TclExprFloatError(interp, dResult);
                         result = TCL_ERROR;
@@ -2291 +1861 @@
                          */
                         if (i2 == 0) {
-                            TRACE(("div %ld %ld => DIVIDE BY ZERO\n",
-                                    i, i2));
                             Tcl_DecrRefCount(valuePtr);
                             Tcl_DecrRefCount(value2Ptr);
@@ -2318 +1886 @@
                     if (doDouble) {
                         PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
-                        TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
-                               d1, d2, dResult));
                     } else {
                         PUSH_OBJECT(Tcl_NewLongObj(iResult));
-                        TRACE(("%s %ld %ld => %ld\n", opName[opCode],
-                               i, i2, iResult));
                     } 
                     TclDecrRefCount(valuePtr);
                 } else {            /* reuse the valuePtr object */
                     if (doDouble) { /* NB: stack top is off by 1 */
-                        TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
-                               d1, d2, dResult));
                         Tcl_SetDoubleObj(valuePtr, dResult);
                     } else {
-                        TRACE(("%s %ld %ld => %ld\n", opName[opCode],
-                               i, i2, iResult));
                         Tcl_SetLongObj(valuePtr, iResult);
                     }
@@ -2363 +1923 @@
                     }
                     if (result != TCL_OK) { 
-                        TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
-                                opName[opCode], s,
-                                (tPtr? tPtr->name : "null")));
                         IllegalExprOperandType(interp, opCode, valuePtr);
                         goto checkForCatch;
                     }
                 }
-                TRACE_WITH_OBJ(("uplus %s => ", O2S(valuePtr)), valuePtr);
             }
             ADJUST_PC(1);
@@ -2399 +1955 @@
                     }
                     if (result != TCL_OK) {
-                        TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s\n",
-                                opName[opCode], s,
-                               (tPtr? tPtr->name : "null")));
                         IllegalExprOperandType(interp, opCode, valuePtr);
                         Tcl_DecrRefCount(valuePtr);
@@ -2417 +1970 @@
                         objPtr = Tcl_NewLongObj(
                                 (opCode == INST_UMINUS)? -i : !i);
-                        TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
-                                objPtr); /* NB: stack top is off by 1 */
                     } else {
                         d = valuePtr->internalRep.doubleValue;
@@ -2430 +1981 @@
                             objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
                         }
-                        TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
-                                objPtr); /* NB: stack top is off by 1 */
                     }
                     PUSH_OBJECT(objPtr);
@@ -2443 +1992 @@
                         Tcl_SetLongObj(valuePtr,
                                 (opCode == INST_UMINUS)? -i : !i);
-                        TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
-                                valuePtr); /* NB: stack top is off by 1 */
                     } else {
                         d = valuePtr->internalRep.doubleValue;
@@ -2456 +2003 @@
                             Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
                         }
-                        TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
-                                valuePtr); /* NB: stack top is off by 1 */
                     }
                     ++stackTop; /* valuePtr now on stk top has right r.c. */
@@ -2481 +2026 @@
                             valuePtr, &i);
                     if (result != TCL_OK) {   /* try to convert to double */
-                        TRACE(("bitnot \"%.20s\" => ILLEGAL TYPE %s\n",
-                               O2S(valuePtr), (tPtr? tPtr->name : "null")));
                         IllegalExprOperandType(interp, opCode, valuePtr);
                         Tcl_DecrRefCount(valuePtr);
@@ -2492 +2035 @@
                 if (Tcl_IsShared(valuePtr)) {
                     PUSH_OBJECT(Tcl_NewLongObj(~i));
-                    TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
                     TclDecrRefCount(valuePtr);
                 } else {
@@ -2500 +2042 @@
                     Tcl_SetLongObj(valuePtr, ~i);
                     ++stackTop; /* valuePtr now on stk top has right r.c. */
-                    TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
                 }
             }
@@ -2515 +2056 @@
 
                 if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
-                    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
                     panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
                 }
@@ -2528 +2068 @@
                     goto checkForCatch;
                 }
-                TRACE_WITH_OBJ(("callBuiltinFunc1 %d => ", opnd),
-                        stackPtr[stackTop].o);
             }
             ADJUST_PC(2);
@@ -2555 +2093 @@
                     goto checkForCatch;
                 }
-                TRACE_WITH_OBJ(("callFunc1 %d => ", objc),
-                        stackPtr[stackTop].o);
                 ADJUST_PC(2);
             }
@@ -2627 +2163 @@
                         d = valuePtr->internalRep.doubleValue;
                         if (IS_NAN(d) || IS_INF(d)) {
-                            TRACE(("tryCvtToNumeric \"%.20s\" => IEEE FLOATING PT ERROR\n",
-                                   O2S(valuePtr)));
                             TclExprFloatError(interp, d);
                             result = TCL_ERROR;
@@ -2636 +2170 @@
                     shared = shared;            /* lint, shared not used. */
                     converted = converted;      /* lint, converted not used. */
-                    TRACE(("tryCvtToNumeric \"%.20s\" => numeric, %s, %s\n",
-                           O2S(valuePtr),
-                           (converted? "converted" : "not converted"),
-                           (shared? "shared" : "not shared")));
-                } else {
-                    TRACE(("tryCvtToNumeric \"%.20s\" => not numeric\n",
-                           O2S(valuePtr)));
                 }
             }
@@ -2660 +2187 @@
                     codePtr);
             if (rangePtr == NULL) {
-                TRACE(("break => no encl. loop or catch, returning TCL_BREAK\n"));
                 result = TCL_BREAK;
                 goto abnormalReturn; /* no catch exists to check */
@@ -2667 +2193 @@
             case LOOP_EXCEPTION_RANGE:
                 result = TCL_OK;
-                TRACE(("break => range at %d, new pc %d\n",
-                       rangePtr->codeOffset, rangePtr->breakOffset));
                 break;
             case CATCH_EXCEPTION_RANGE:
                 result = TCL_BREAK;
-                TRACE(("break => ...\n"));
                 goto processCatch; /* it will use rangePtr */
             default:
@@ -2693 +2216 @@
                     codePtr);
             if (rangePtr == NULL) {
-                TRACE(("continue => no encl. loop or catch, returning TCL_CONTINUE\n"));
                 result = TCL_CONTINUE;
                 goto abnormalReturn;
@@ -2700 +2222 @@
             case LOOP_EXCEPTION_RANGE:
                 if (rangePtr->continueOffset == -1) {
-                    TRACE(("continue => loop w/o continue, checking for catch\n"));
                     goto checkForCatch;
                 } else {
                     result = TCL_OK;
-                    TRACE(("continue => range at %d, new pc %d\n",
-                           rangePtr->codeOffset, rangePtr->continueOffset));
                 }
                 break;
             case CATCH_EXCEPTION_RANGE:
                 result = TCL_CONTINUE;
-                TRACE(("continue => ...\n"));
                 goto processCatch; /* it will use rangePtr */
             default:
@@ -2744 +2262 @@
                 TclSetVarScalar(iterVarPtr);
                 TclClearVarUndefined(iterVarPtr);
-                TRACE(("foreach_start4 %u => loop iter count temp %d\n", 
-                        opnd, iterTmpIndex));
             }
             ADJUST_PC(5);
@@ -2794 +2310 @@
                     result = Tcl_ListObjLength(interp, listPtr, &listLen);
                     if (result != TCL_OK) {
-                        TRACE_WITH_OBJ(("foreach_step4 %u => ERROR converting list %ld, \"%s\": ",
-                                opnd, i, O2S(listPtr)),
-                                Tcl_GetObjResult(interp));
                         goto checkForCatch;
                     }
@@ -2840 +2353 @@
                             CACHE_STACK_INFO();
                             if (value2Ptr == NULL) {
-                                TRACE_WITH_OBJ(("foreach_step4 %u => ERROR init. index temp %d: ",
-                                       opnd, varIndex),
-                                       Tcl_GetObjResult(interp));
                                 if (setEmptyStr) {
                                     Tcl_DecrRefCount(elemPtr); /* unneeded */
@@ -2862 +2372 @@
 
                 PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
-                TRACE(("foreach_step4 %u => %d lists, iter %d, %s loop\n", 
-                        opnd, numLists, iterNum,
-                        (continueLoop? "continue" : "exit")));
             }
             ADJUST_PC(5);
@@ -2875 +2382 @@
              */
             catchStackPtr[++catchTop] = stackTop;
-            TRACE(("beginCatch4 %u => catchTop=%d, stackTop=%d\n",
-                    TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
             ADJUST_PC(5);
 
@@ -2882 +2387 @@
             catchTop--;
             result = TCL_OK;
-            TRACE(("endCatch => catchTop=%d\n", catchTop));
             ADJUST_PC(1);
 
         case INST_PUSH_RESULT:
             PUSH_OBJECT(Tcl_GetObjResult(interp));
-            TRACE_WITH_OBJ(("pushResult => "), Tcl_GetObjResult(interp));
             ADJUST_PC(1);
 
         case INST_PUSH_RETURN_CODE:
             PUSH_OBJECT(Tcl_NewLongObj(result));
-            TRACE(("pushReturnCode => %u\n", result));
             ADJUST_PC(1);
 
         default:
-            TRACE(("UNRECOGNIZED INSTRUCTION %u\n", opCode));
             panic("TclExecuteByteCode: unrecognized opCode %u", opCode);
         } /* end of switch on opCode */
@@ -2926 +2427 @@
         rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 1, codePtr);
         if (rangePtr == NULL) {
-            TRACE(("   ... no enclosing catch, returning %s\n",
-                    StringForResultCode(result)));
             goto abnormalReturn;
         }
@@ -2945 +2444 @@
             TclDecrRefCount(valuePtr);
         }
-        TRACE(("  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
-                rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
-                (unsigned int)(rangePtr->catchOffset)));
         pc = (codePtr->codeStart + rangePtr->catchOffset);
         continue;               /* restart the execution loop at pc */
@@ -2975 +2471 @@
 #undef STATIC_CATCH_STACK_SIZE
 }
-
-
-/*
- *----------------------------------------------------------------------
- *
- * PrintByteCodeInfo --
- *
- *      This procedure prints a summary about a bytecode object to stdout.
- *      It is called by TclExecuteByteCode when starting to execute the
- *      bytecode object if tclTraceExec has the value 2 or more.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PrintByteCodeInfo(codePtr)
-    register ByteCode *codePtr; /* The bytecode whose summary is printed
-                                 * to stdout. */
-{
-    Proc *procPtr = codePtr->procPtr;
-    int numCmds = codePtr->numCommands;
-    int numObjs = codePtr->numObjects;
-    int objBytes, i;
-
-    objBytes = (numObjs * sizeof(Tcl_Obj));
-    for (i = 0;  i < numObjs;  i++) {
-        Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
-        if (litObjPtr->bytes != NULL) {
-            objBytes += litObjPtr->length;
-        }
-    }
-    
-    fprintf(stdout, "\nExecuting ByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
-            (unsigned int) codePtr, codePtr->refCount,
-            codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
-            codePtr->iPtr->compileEpoch);
-    
-    fprintf(stdout, "  Source: ");
-    TclPrintSource(stdout, codePtr->source, 70);
-
-    fprintf(stdout, "\n  Cmds %d, chars %d, inst %u, objs %u, aux %d, stk depth %u, code/src %.2fn",
-            numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
-            codePtr->numAuxDataItems, codePtr->maxStackDepth,
-            (codePtr->numSrcChars?
-                    ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
-
-    fprintf(stdout, "  Code %zu = %u(header)+%d(inst)+%d(objs)+%u(exc)+%u(aux)+%d(cmd map)\n",
-            codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
-            objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
-            (codePtr->numAuxDataItems * sizeof(AuxData)),
-            codePtr->numCmdLocBytes);
-
-    if (procPtr != NULL) {
-        fprintf(stdout,
-                "  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
-                (unsigned int) procPtr, procPtr->refCount,
-                procPtr->numArgs, procPtr->numCompiledLocals);
-    }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * ValidatePcAndStackTop --
- *
- *      This procedure is called by TclExecuteByteCode when debugging to
- *      verify that the program counter and stack top are valid during
- *      execution.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *      Prints a message to stderr and panics if either the pc or stack
- *      top are invalid.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_COMPILE_DEBUG
-static void
-ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, stackUpperBound)
-    register ByteCode *codePtr; /* The bytecode whose summary is printed
-                                 * to stdout. */
-    unsigned char *pc;          /* Points to first byte of a bytecode
-                                 * instruction. The program counter. */
-    int stackTop;               /* Current stack top. Must be between
-                                 * stackLowerBound and stackUpperBound
-                                 * (inclusive). */
-    int stackLowerBound;        /* Smallest legal value for stackTop. */
-    int stackUpperBound;        /* Greatest legal value for stackTop. */
-{
-    unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart);
-    unsigned int codeStart = (unsigned int) codePtr->codeStart;
-    unsigned int codeEnd = (unsigned int)
-            (codePtr->codeStart + codePtr->numCodeBytes);
-    unsigned char opCode = *pc;
-
-    if (((unsigned int) pc < codeStart) || ((unsigned int) pc > codeEnd)) {
-        fprintf(stderr, "\nBad instruction pc 0x%x in TclExecuteByteCode\n",
-                (unsigned int) pc);
-        panic("TclExecuteByteCode execution failure: bad pc");
-    }
-    if ((unsigned int) opCode > LAST_INST_OPCODE) {
-        fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n",
-                (unsigned int) opCode, relativePc);
-        panic("TclExecuteByteCode execution failure: bad opcode");
-    }
-    if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
-        int numChars;
-        char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
-        char *ellipsis = "";
-        
-        fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode",
-                stackTop, relativePc);
-        if (cmd != NULL) {
-            if (numChars > 100) {
-                numChars = 100;
-                ellipsis = "...";
-            }
-            fprintf(stderr, "\n executing %.*s%s\n", numChars, cmd,
-                    ellipsis);
-        } else {
-            fprintf(stderr, "\n");
-        }
-        panic("TclExecuteByteCode execution failure: bad stack top");
-    }
-}
-#endif /* TCL_COMPILE_DEBUG */
 
 
@@ -4271 +3631 @@
 
 
-#ifdef TCL_COMPILE_STATS
-/*
- *----------------------------------------------------------------------
- *
- * TclLog2 --
- *
- *      Procedure used while collecting compilation statistics to determine
- *      the log base 2 of an integer.
- *
- * Results:
- *      Returns the log base 2 of the operand. If the argument is less
- *      than or equal to zero, a zero is returned.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclLog2(value)
-    register int value;         /* The integer for which to compute the
-                                 * log base 2. */
-{
-    register int n = value;
-    register int result = 0;
-
-    while (n > 1) {
-        n = n >> 1;
-        result++;
-    }
-    return result;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * EvalStatsCmd --
- *
- *      Implements the "evalstats" command that prints instruction execution
- *      counts to stdout.
- *
- * Results:
- *      Standard Tcl results.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-EvalStatsCmd(unused, interp, argc, argv)
-    ClientData unused;          /* Unused. */
-    Tcl_Interp *interp;         /* The current interpreter. */
-    int argc;                   /* The number of arguments. */
-    char **argv;                /* The argument strings. */
-{
-    register double total = 0.0;
-    register int i;
-    int maxSizeDecade = 0;
-    double totalHeaderBytes = (tclNumCompilations * sizeof(ByteCode));
-
-    for (i = 0;  i < 256;  i++) {
-        if (instructionCount[i] != 0) {
-            total += instructionCount[i];
-        }
-    }
-
-    for (i = 31;  i >= 0;  i--) {
-        if ((tclSourceCount[i] > 0) && (tclByteCodeCount[i] > 0)) {
-            maxSizeDecade = i;
-            break;
-        }
-    } 
-
-    fprintf(stdout, "\nNumber of compilations           %ld\n",
-            tclNumCompilations);
-    fprintf(stdout, "Number of executions               %ld\n",
-            numExecutions);
-    fprintf(stdout, "Average executions/compilation     %.0f\n",
-            ((float) numExecutions/tclNumCompilations));
-    
-    fprintf(stdout, "\nInstructions executed            %.0f\n",
-            total);
-    fprintf(stdout, "Average instructions/compile       %.0f\n",
-            total/tclNumCompilations);
-    fprintf(stdout, "Average instructions/execution     %.0f\n",
-            total/numExecutions);
-    
-    fprintf(stdout, "\nTotal source bytes               %.6g\n",
-            tclTotalSourceBytes);
-    fprintf(stdout, "Total code bytes           %.6g\n",
-            tclTotalCodeBytes);
-    fprintf(stdout, "Average code/compilation   %.0f\n",
-            tclTotalCodeBytes/tclNumCompilations);
-    fprintf(stdout, "Average code/source                %.2f\n",
-            tclTotalCodeBytes/tclTotalSourceBytes);
-    fprintf(stdout, "Current source bytes               %.6g\n",
-            tclCurrentSourceBytes);
-    fprintf(stdout, "Current code bytes         %.6g\n",
-            tclCurrentCodeBytes);
-    fprintf(stdout, "Current code/source                %.2f\n",
-            tclCurrentCodeBytes/tclCurrentSourceBytes);
-    
-    fprintf(stdout, "\nTotal objects allocated          %ld\n",
-            tclObjsAlloced);
-    fprintf(stdout, "Total objects freed                %ld\n",
-            tclObjsFreed);
-    fprintf(stdout, "Current objects:           %ld\n",
-            (tclObjsAlloced - tclObjsFreed));
-
-    fprintf(stdout, "\nBreakdown of code byte requirements:\n");
-    fprintf(stdout, "                   Total bytes      Pct of    Avg per\n");
-    fprintf(stdout, "                                  all code    compile\n");
-    fprintf(stdout, "Total code        %12.6g        100%%   %8.2f\n",
-            tclTotalCodeBytes, tclTotalCodeBytes/tclNumCompilations);
-    fprintf(stdout, "Header            %12.6g   %8.2f%%   %8.2f\n",
-            totalHeaderBytes,
-            ((totalHeaderBytes * 100.0) / tclTotalCodeBytes),
-            totalHeaderBytes/tclNumCompilations);
-    fprintf(stdout, "Instructions      %12.6g   %8.2f%%   %8.2f\n",
-            tclTotalInstBytes,
-            ((tclTotalInstBytes * 100.0) / tclTotalCodeBytes),
-            tclTotalInstBytes/tclNumCompilations);
-    fprintf(stdout, "Objects           %12.6g   %8.2f%%   %8.2f\n",
-            tclTotalObjBytes,
-            ((tclTotalObjBytes * 100.0) / tclTotalCodeBytes),
-            tclTotalObjBytes/tclNumCompilations);
-    fprintf(stdout, "Exception table   %12.6g   %8.2f%%   %8.2f\n",
-            tclTotalExceptBytes,
-            ((tclTotalExceptBytes * 100.0) / tclTotalCodeBytes),
-            tclTotalExceptBytes/tclNumCompilations);
-    fprintf(stdout, "Auxiliary data    %12.6g   %8.2f%%   %8.2f\n",
-            tclTotalAuxBytes,
-            ((tclTotalAuxBytes * 100.0) / tclTotalCodeBytes),
-            tclTotalAuxBytes/tclNumCompilations);
-    fprintf(stdout, "Command map       %12.6g   %8.2f%%   %8.2f\n",
-            tclTotalCmdMapBytes,
-            ((tclTotalCmdMapBytes * 100.0) / tclTotalCodeBytes),
-            tclTotalCmdMapBytes/tclNumCompilations);
-    
-    fprintf(stdout, "\nSource and ByteCode size distributions:\n");
-    fprintf(stdout, "    binary decade          source    code\n");
-    for (i = 0;  i <= maxSizeDecade;  i++) {
-        int decadeLow, decadeHigh;
-
-        if (i == 0) {
-            decadeLow = 0;
-        } else {
-            decadeLow = 1 << i;
-        }
-        decadeHigh = (1 << (i+1)) - 1;
-        fprintf(stdout, "       %6d -%6d                %6d     %6d\n",
-                decadeLow, decadeHigh,
-                tclSourceCount[i], tclByteCodeCount[i]);
-    }
-
-    fprintf(stdout, "\nInstruction counts:\n");
-    for (i = 0;  i < 256;  i++) {
-        if (instructionCount[i]) {
-            fprintf(stdout, "%20s %8d %6.2f%%\n",
-                    opName[i], instructionCount[i],
-                    (instructionCount[i] * 100.0)/total);
-        }
-    }
-
-#ifdef TCL_MEM_DEBUG
-    fprintf(stdout, "\nHeap Statistics:\n");
-    TclDumpMemoryInfo(stdout);
-#endif /* TCL_MEM_DEBUG */
-
-    return TCL_OK;
-}
-#endif /* TCL_COMPILE_STATS */
-
-
 /*
  *----------------------------------------------------------------------
@@ -4758 +3940 @@
     panic("UpdateStringOfCmdName should never be invoked");
 }
-
-
-#ifdef TCL_COMPILE_DEBUG
-/*
- *----------------------------------------------------------------------
- *
- * StringForResultCode --
- *
- *      Procedure that returns a human-readable string representing a
- *      Tcl result code such as TCL_ERROR. 
- *
- * Results:
- *      If the result code is one of the standard Tcl return codes, the
- *      result is a string representing that code such as "TCL_ERROR".
- *      Otherwise, the result string is that code formatted as a
- *      sequence of decimal digit characters. Note that the resulting
- *      string must not be modified by the caller.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-static char *
-StringForResultCode(result)
-    int result;                 /* The Tcl result code for which to
-                                 * generate a string. */
-{
-    static char buf[20];
-    
-    if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
-        return resultStrings[result];
-    }
-    TclFormatInt(buf, result);
-    return buf;
-}
-#endif /* TCL_COMPILE_DEBUG */

external/tcl/tclInt.h

@@ -1326 +1326 @@
 
 extern Tcl_Obj *        tclFreeObjList;
-
-#ifdef TCL_COMPILE_STATS
-extern long             tclObjsAlloced;
-extern long             tclObjsFreed;
-#endif /* TCL_COMPILE_STATS */
 
 /*
@@ -1445 +1440 @@
                             int objc, Tcl_Obj *CONST objv[], int flags));
 EXTERN char *           TclpAlloc _ANSI_ARGS_((unsigned int size));
-
+EXTERN void             TclpFree(char *cp);
 EXTERN char *           TclpRealloc _ANSI_ARGS_((char *ptr,
                             unsigned int size));
@@ -1472 +1467 @@
 EXTERN int              TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
                             Tcl_Interp *cmdInterp, Tcl_Command cmd));
-EXTERN void             TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
-                            Tcl_Obj *objPtr));
 EXTERN void             TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
 EXTERN int              TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
@@ -1688 +1681 @@
  */
 
-#ifdef TCL_COMPILE_STATS
-#  define TclIncrObjsAllocated() \
-    tclObjsAlloced++
-#  define TclIncrObjsFreed() \
-    tclObjsFreed++
-#else
-#  define TclIncrObjsAllocated()
-#  define TclIncrObjsFreed()
-#endif /* TCL_COMPILE_STATS */
-
-#ifdef TCL_MEM_DEBUG
-#  define TclNewObj(objPtr) \
-    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), __FILE__, __LINE__); \
-    (objPtr)->refCount = 0; \
-    (objPtr)->bytes    = tclEmptyStringRep; \
-    (objPtr)->length   = 0; \
-    (objPtr)->typePtr  = NULL; \
-    TclIncrObjsAllocated()
-#  define TclDbNewObj(objPtr, file, line) \
-    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
-    (objPtr)->refCount = 0; \
-    (objPtr)->bytes    = tclEmptyStringRep; \
-    (objPtr)->length   = 0; \
-    (objPtr)->typePtr  = NULL; \
-    TclIncrObjsAllocated()
-#  define TclDecrRefCount(objPtr) \
-    if (--(objPtr)->refCount <= 0) { \
-        if ((objPtr)->refCount < -1) \
-            panic("Reference count for %lx was negative: %s line %d", \
-                  (objPtr), __FILE__, __LINE__); \
-        if (((objPtr)->bytes != NULL) \
-                && ((objPtr)->bytes != tclEmptyStringRep)) { \
-            ckfree((char *) (objPtr)->bytes); \
-        } \
-        if (((objPtr)->typePtr != NULL) \
-                && ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
-            (objPtr)->typePtr->freeIntRepProc(objPtr); \
-        } \
-        ckfree((char *) (objPtr)); \
-        TclIncrObjsFreed(); \
-    }
-#else /* not TCL_MEM_DEBUG */
 #  define TclNewObj(objPtr) \
     if (tclFreeObjList == NULL) { \
@@ -1740 +1691 @@
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
-    (objPtr)->typePtr  = NULL; \
-    TclIncrObjsAllocated()
+    (objPtr)->typePtr  = NULL;
 #  define TclDecrRefCount(objPtr) \
     if (--(objPtr)->refCount <= 0) { \
@@ -1754 +1704 @@
         (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
         tclFreeObjList = (objPtr); \
-        TclIncrObjsFreed(); \
     }
-#endif /* TCL_MEM_DEBUG */
 
 /*

external/tcl/tclListObj.c

@@ -46 +46 @@
  * Tcl_NewListObj --
  *
- *      This procedure is normally called when not debugging: i.e., when
- *      TCL_MEM_DEBUG is not defined. It creates a new list object from an
- *      (objc,objv) array: that is, each of the objc elements of the array
- *      referenced by objv is inserted as an element into a new Tcl object.
- *
- *      When TCL_MEM_DEBUG is defined, this procedure just returns the
- *      result of calling the debugging version Tcl_DbNewListObj.
+ *      This procedure creates a new list object from an (objc,objv) array:
+ *      that is, each of the objc elements of the array referenced by objv
+ *      is inserted as an element into a new Tcl object.
  *
  * Results:
@@ -66 +62 @@
  *----------------------------------------------------------------------
  */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewListObj
-
-Tcl_Obj *
-Tcl_NewListObj(objc, objv)
-    int objc;                   /* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
-{
-    return Tcl_DbNewListObj(objc, objv, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
@@ -112 +95 @@
     return listPtr;
 }
-#endif /* if TCL_MEM_DEBUG */
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewListObj --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. It creates new list objects. It is the
- *      same as the Tcl_NewListObj procedure above except that it calls
- *      Tcl_DbCkalloc directly with the file name and line number from its
- *      caller. This simplifies debugging since then the checkmem command
- *      will report the correct file name and line number when reporting
- *      objects that haven't been freed.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
- *      result of calling Tcl_NewListObj.
- *
- * Results:
- *      A new list object is returned that is initialized from the object
- *      pointers in objv. If objc is less than or equal to zero, an empty
- *      object is returned. The new object's string representation
- *      is left NULL. The new list object has ref count 0.
- *
- * Side effects:
- *      The ref counts of the elements in objv are incremented since the
- *      resulting list now refers to them.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
-    int objc;                   /* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    register Tcl_Obj *listPtr;
-    register Tcl_Obj **elemPtrs;
-    register List *listRepPtr;
-    int i;
-    
-    TclDbNewObj(listPtr, file, line);
-    
-    if (objc > 0) {
-        Tcl_InvalidateStringRep(listPtr);
-        
-        elemPtrs = (Tcl_Obj **)
-            ckalloc((unsigned) (objc * sizeof(Tcl_Obj *)));
-        for (i = 0;  i < objc;  i++) {
-            elemPtrs[i] = objv[i];
-            Tcl_IncrRefCount(elemPtrs[i]);
-        }
-        
-        listRepPtr = (List *) ckalloc(sizeof(List));
-        listRepPtr->maxElemCount = objc;
-        listRepPtr->elemCount    = objc;
-        listRepPtr->elements     = elemPtrs;
-        
-        listPtr->internalRep.otherValuePtr = (VOID *) listRepPtr;
-        listPtr->typePtr = &tclListType;
-    }
-    return listPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewListObj(objc, objv, file, line)
-    int objc;                   /* Count of objects referenced by objv. */
-    Tcl_Obj *CONST objv[];      /* An array of pointers to Tcl objects. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    return Tcl_NewListObj(objc, objv);
-}
-#endif /* TCL_MEM_DEBUG */
 
 

external/tcl/tclObj.c

@@ -36 +36 @@
 
 char *tclEmptyStringRep = NULL;
-
-/*
- * Count of the number of Tcl objects every allocated (by Tcl_NewObj) and
- * freed (by TclFreeObj).
- */
-
-#ifdef TCL_COMPILE_STATS
-long tclObjsAlloced = 0;
-long tclObjsFreed = 0;
-#endif /* TCL_COMPILE_STATS */
 
 /*
@@ -417 +407 @@
  * Tcl_NewObj --
  *
- *      This procedure is normally called when not debugging: i.e., when
- *      TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote
- *      the empty string. These objects have a NULL object type and NULL
- *      string representation byte pointer. Type managers call this routine
- *      to allocate new objects that they further initialize.
- *
- *      When TCL_MEM_DEBUG is defined, this procedure just returns the
- *      result of calling the debugging version Tcl_DbNewObj.
+ *      This procedure creates new Tcl objects that denote the empty string.
+ *      These objects have a NULL object type and NULL string representation
+ *      byte pointer. Type managers call this routine to allocate new objects
+ *      that they further initialize.
  *
  * Results:
@@ -431 +417 @@
  *      is set to 0.
  *
- * Side effects:
- *      If compiling with TCL_COMPILE_STATS, this procedure increments
- *      the global count of allocated objects (tclObjsAlloced).
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewObj
-
-Tcl_Obj *
-Tcl_NewObj()
-{
-    return Tcl_DbNewObj("unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
+ *----------------------------------------------------------------------
+ */
 
 Tcl_Obj *
@@ -468 +439 @@
     objPtr->length   = 0;
     objPtr->typePtr  = NULL;
-#ifdef TCL_COMPILE_STATS
-    tclObjsAlloced++;
-#endif /* TCL_COMPILE_STATS */
     return objPtr;
 }
-#endif /* TCL_MEM_DEBUG */
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewObj --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the
- *      empty string. It is the same as the Tcl_NewObj procedure above
- *      except that it calls Tcl_DbCkalloc directly with the file name and
- *      line number from its caller. This simplifies debugging since then
- *      the checkmem command will report the correct file name and line
- *      number when reporting objects that haven't been freed.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
- *      result of calling Tcl_NewObj.
- *
- * Results:
- *      The result is a newly allocated that represents the empty string.
- *      The new object's typePtr is set NULL and its ref count is set to 0.
- *
- * Side effects:
- *      If compiling with TCL_COMPILE_STATS, this procedure increments
- *      the global count of allocated objects (tclObjsAlloced).
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewObj(file, line)
-    register char *file;        /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    register int line;          /* Line number in the source file; used
-                                 * for debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    /*
-     * If debugging Tcl's memory usage, allocate the object using ckalloc.
-     * Otherwise, allocate it using the list of free Tcl_Objs we maintain.
-     */
-
-    objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line);
-    objPtr->refCount = 0;
-    objPtr->bytes    = tclEmptyStringRep;
-    objPtr->length   = 0;
-    objPtr->typePtr  = NULL;
-#ifdef TCL_COMPILE_STATS
-    tclObjsAlloced++;
-#endif /* TCL_COMPILE_STATS */
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewObj(file, line)
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    return Tcl_NewObj();
-}
-#endif /* TCL_MEM_DEBUG */
 
 
@@ -609 +508 @@
  *      after deallocating the string representation and calling the
  *      type-specific Tcl_FreeInternalRepProc to deallocate the object's
- *      internal representation. If compiling with TCL_COMPILE_STATS,
- *      this procedure increments the global count of freed objects
- *      (tclObjsFreed).
+ *      internal representation.
  *
  *----------------------------------------------------------------------
@@ -622 +519 @@
     register Tcl_ObjType *typePtr = objPtr->typePtr;
     
-#ifdef TCL_MEM_DEBUG
-    if ((objPtr)->refCount < -1) {
-        panic("Reference count for %lx was negative", objPtr);
-    }
-#endif /* TCL_MEM_DEBUG */
-
     Tcl_InvalidateStringRep(objPtr);
     if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
@@ -634 +525 @@
 
     /*
-     * If debugging Tcl's memory usage, deallocate the object using ckfree.
-     * Otherwise, deallocate it by adding it onto the list of free
+     * Deallocate the object by adding it onto the list of free
      * Tcl_Objs we maintain.
      */
     
-#ifdef TCL_MEM_DEBUG
-    ckfree((char *) objPtr);
-#else
     objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
     tclFreeObjList = objPtr;
-#endif /* TCL_MEM_DEBUG */
-
-#ifdef TCL_COMPILE_STATS    
-    tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */    
 }
 
@@ -794 +676 @@
  * Tcl_NewBooleanObj --
  *
- *      This procedure is normally called when not debugging: i.e., when
- *      TCL_MEM_DEBUG is not defined. It creates a new boolean object and
- *      initializes it from the argument boolean value. A nonzero
- *      "boolValue" is coerced to 1.
- *
- *      When TCL_MEM_DEBUG is defined, this procedure just returns the
- *      result of calling the debugging version Tcl_DbNewBooleanObj.
+ *      This procedure creates a new boolean object and initializes it from
+ *      the argument boolean value. A nonzero "boolValue" is coerced to 1.
  *
  * Results:
@@ -811 +688 @@
  *----------------------------------------------------------------------
  */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewBooleanObj
 
 Tcl_Obj *
@@ -819 +693 @@
     register int boolValue;     /* Boolean used to initialize new object. */
 {
-    return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewBooleanObj(boolValue)
-    register int boolValue;     /* Boolean used to initialize new object. */
-{
     register Tcl_Obj *objPtr;
 
@@ -837 +702 @@
     return objPtr;
 }
-#endif /* TCL_MEM_DEBUG */
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewBooleanObj --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
- *      same as the Tcl_NewBooleanObj procedure above except that it calls
- *      Tcl_DbCkalloc directly with the file name and line number from its
- *      caller. This simplifies debugging since then the checkmem command
- *      will report the correct file name and line number when reporting
- *      objects that haven't been freed.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
- *      result of calling Tcl_NewBooleanObj.
- *
- * Results:
- *      The newly created object is returned. This object will have an
- *      invalid string representation. The returned object has ref count 0.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
-    register int boolValue;     /* Boolean used to initialize new object. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.longValue = (boolValue? 1 : 0);
-    objPtr->typePtr = &tclBooleanType;
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(boolValue, file, line)
-    register int boolValue;     /* Boolean used to initialize new object. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    return Tcl_NewBooleanObj(boolValue);
-}
-#endif /* TCL_MEM_DEBUG */
 
 
@@ -1178 +981 @@
  * Tcl_NewDoubleObj --
  *
- *      This procedure is normally called when not debugging: i.e., when
- *      TCL_MEM_DEBUG is not defined. It creates a new double object and
- *      initializes it from the argument double value.
- *
- *      When TCL_MEM_DEBUG is defined, this procedure just returns the
- *      result of calling the debugging version Tcl_DbNewDoubleObj.
+ *      This procedure creates a new double object and initializes it from
+ *      the argument double value.
  *
  * Results:
@@ -1194 +993 @@
  *----------------------------------------------------------------------
  */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewDoubleObj
 
 Tcl_Obj *
@@ -1202 +998 @@
     register double dblValue;   /* Double used to initialize the object. */
 {
-    return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewDoubleObj(dblValue)
-    register double dblValue;   /* Double used to initialize the object. */
-{
     register Tcl_Obj *objPtr;
 
@@ -1220 +1007 @@
     return objPtr;
 }
-#endif /* if TCL_MEM_DEBUG */
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewDoubleObj --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. It creates new double objects. It is the
- *      same as the Tcl_NewDoubleObj procedure above except that it calls
- *      Tcl_DbCkalloc directly with the file name and line number from its
- *      caller. This simplifies debugging since then the checkmem command
- *      will report the correct file name and line number when reporting
- *      objects that haven't been freed.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
- *      result of calling Tcl_NewDoubleObj.
- *
- * Results:
- *      The newly created object is returned. This object will have an
- *      invalid string representation. The returned object has ref count 0.
- *
- * Side effects:
- *      None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
-    register double dblValue;   /* Double used to initialize the object. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.doubleValue = dblValue;
-    objPtr->typePtr = &tclDoubleType;
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewDoubleObj(dblValue, file, line)
-    register double dblValue;   /* Double used to initialize the object. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    return Tcl_NewDoubleObj(dblValue);
-}
-#endif /* TCL_MEM_DEBUG */
 
 
@@ -1531 +1256 @@
  * Tcl_NewIntObj --
  *
- *      If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *      Tcl_NewIntObj to create a new integer object end up calling the
- *      debugging procedure Tcl_DbNewLongObj instead.
- *
- *      Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- *      calls to Tcl_NewIntObj result in a call to one of the two
+ *      Calls to Tcl_NewIntObj result in a call to one of the two
  *      Tcl_NewIntObj implementations below. We provide two implementations
  *      so that the Tcl core can be compiled to do memory debugging of the 
@@ -1556 +1276 @@
  */
 
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewIntObj
-
 Tcl_Obj *
 Tcl_NewIntObj(intValue)
     register int intValue;      /* Int used to initialize the new object. */
 {
-    return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewIntObj(intValue)
-    register int intValue;      /* Int used to initialize the new object. */
-{
     register Tcl_Obj *objPtr;
 
@@ -1581 +1289 @@
     return objPtr;
 }
-#endif /* if TCL_MEM_DEBUG */
 
 
@@ -1856 +1563 @@
  * Tcl_NewLongObj --
  *
- *      If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *      Tcl_NewLongObj to create a new long integer object end up calling
- *      the debugging procedure Tcl_DbNewLongObj instead.
- *
- *      Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- *      calls to Tcl_NewLongObj result in a call to one of the two
+ *      Calls to Tcl_NewLongObj result in a call to one of the two
  *      Tcl_NewLongObj implementations below. We provide two implementations
  *      so that the Tcl core can be compiled to do memory debugging of the 
@@ -1881 +1583 @@
  */
 
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewLongObj
-
 Tcl_Obj *
 Tcl_NewLongObj(longValue)
@@ -1889 +1588 @@
                                  * new object. */
 {
-    return Tcl_DbNewLongObj(longValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewLongObj(longValue)
-    register long longValue;    /* Long integer used to initialize the
-                                 * new object. */
-{
     register Tcl_Obj *objPtr;
 
@@ -1908 +1597 @@
     return objPtr;
 }
-#endif /* if TCL_MEM_DEBUG */
 
 
@@ -1916 +1604 @@
  * Tcl_DbNewLongObj --
  *
- *      If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *      Tcl_NewIntObj and Tcl_NewLongObj to create new integer or
- *      long integer objects end up calling the debugging procedure
- *      Tcl_DbNewLongObj instead. We provide two implementations of
- *      Tcl_DbNewLongObj so that whether the Tcl core is compiled to do
- *      memory debugging of the core is independent of whether a client
- *      requests debugging for itself.
- *
- *      When the core is compiled with TCL_MEM_DEBUG defined,
- *      Tcl_DbNewLongObj calls Tcl_DbCkalloc directly with the file name and
- *      line number from its caller. This simplifies debugging since then
- *      the checkmem command will report the caller's file name and line
- *      number when reporting objects that haven't been freed.
- *
- *      Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- *      this procedure just returns the result of calling Tcl_NewLongObj.
+ *      This procedure just returns the result of calling Tcl_NewLongObj.
  *
  * Results:
@@ -1943 +1616 @@
  *----------------------------------------------------------------------
  */
-
-#ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
@@ -1955 +1626 @@
                                  * for debugging. */
 {
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-    
-    objPtr->internalRep.longValue = longValue;
-    objPtr->typePtr = &tclIntType;
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewLongObj(longValue, file, line)
-    register long longValue;    /* Long integer used to initialize the
-                                 * new object. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
     return Tcl_NewLongObj(longValue);
 }
-#endif /* TCL_MEM_DEBUG */
 
 
@@ -2060 +1709 @@
     return result;
 }
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbIncrRefCount --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. This checks to see whether or not
- *      the memory has been freed before incrementing the ref count.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just increments
- *      the reference count of the object.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *      The object's ref count is incremented.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DbIncrRefCount(objPtr, file, line)
-    register Tcl_Obj *objPtr;   /* The object we are adding a reference to. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-#ifdef TCL_MEM_DEBUG
-    if (objPtr->refCount == 0x61616161) {
-        fprintf(stderr, "file = %s, line = %d\n", file, line);
-        fflush(stderr);
-        panic("Trying to increment refCount of previously disposed object.");
-    }
-#endif
-    ++(objPtr)->refCount;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbDecrRefCount --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. This checks to see whether or not
- *      the memory has been freed before incrementing the ref count.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just increments
- *      the reference count of the object.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *      The object's ref count is incremented.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DbDecrRefCount(objPtr, file, line)
-    register Tcl_Obj *objPtr;   /* The object we are adding a reference to. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-#ifdef TCL_MEM_DEBUG
-    if (objPtr->refCount == 0x61616161) {
-        fprintf(stderr, "file = %s, line = %d\n", file, line);
-        fflush(stderr);
-        panic("Trying to decrement refCount of previously disposed object.");
-    }
-#endif
-    if (--(objPtr)->refCount <= 0) {
-        TclFreeObj(objPtr);
-    }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbIsShared --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. This checks to see whether or not
- *      the memory has been freed before incrementing the ref count.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just decrements
- *      the reference count of the object and throws it away if the count
- *      is 0 or less.
- *
- * Results:
- *      None.
- *
- * Side effects:
- *      The object's ref count is incremented.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_DbIsShared(objPtr, file, line)
-    register Tcl_Obj *objPtr;   /* The object we are adding a reference to. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-#ifdef TCL_MEM_DEBUG
-    if (objPtr->refCount == 0x61616161) {
-        fprintf(stderr, "file = %s, line = %d\n", file, line);
-        fflush(stderr);
-        panic("Trying to check whether previously disposed object is shared.");
-    }
-#endif
-    return ((objPtr)->refCount > 1);
-}

external/tcl/tclProc.c

@@ -985 +985 @@
      */
 
-    if (tclTraceExec >= 1) {
-        fprintf(stdout, "Calling proc ");
-        for (i = 0;  i < objc;  i++) {
-            bytes = Tcl_GetStringFromObj(objv[i], &length);
-            TclPrintSource(stdout, bytes, TclMin(length, 15));
-            fprintf(stdout, " ");
-        }
-        fprintf(stdout, "\n");
-        fflush(stdout);
-    }
-
     iPtr->returnCode = TCL_OK;
     procPtr->refCount++;
@@ -1119 +1108 @@
         int numChars;
         char *ellipsis;
-        
-        if (tclTraceCompile >= 1) {
-            /*
-             * Display a line summarizing the top level command we
-             * are about to compile.
-             */
- 
-            numChars = strlen(procName);
-            ellipsis = "";
-            if (numChars > 50) {
-                numChars = 50;
-                ellipsis = "...";
-            }
-            fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
-                    description, numChars, procName, ellipsis);
-        }
         
         /*

external/tcl/tclStringObj.c

@@ -50 +50 @@
  * Tcl_NewStringObj --
  *
- *      This procedure is normally called when not debugging: i.e., when
- *      TCL_MEM_DEBUG is not defined. It creates a new string object and
- *      initializes it from the byte pointer and length arguments.
- *
- *      When TCL_MEM_DEBUG is defined, this procedure just returns the
- *      result of calling the debugging version Tcl_DbNewStringObj.
+ *      This procedure creates a new string object and initializes it from
+ *      the byte pointer and length arguments.
  *
  * Results:
@@ -70 +66 @@
  *----------------------------------------------------------------------
  */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewStringObj
 
 Tcl_Obj *
@@ -83 +76 @@
                                  * NULL byte. */
 {
-    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewStringObj(bytes, length)
-    register char *bytes;       /* Points to the first of the length bytes
-                                 * used to initialize the new object. */
-    register int length;        /* The number of bytes to copy from "bytes"
-                                 * when initializing the new object. If 
-                                 * negative, use bytes up to the first
-                                 * NULL byte. */
-{
     register Tcl_Obj *objPtr;
 
@@ -106 +85 @@
     return objPtr;
 }
-#endif /* TCL_MEM_DEBUG */
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewStringObj --
- *
- *      This procedure is normally called when debugging: i.e., when
- *      TCL_MEM_DEBUG is defined. It creates new string objects. It is the
- *      same as the Tcl_NewStringObj procedure above except that it calls
- *      Tcl_DbCkalloc directly with the file name and line number from its
- *      caller. This simplifies debugging since then the checkmem command
- *      will report the correct file name and line number when reporting
- *      objects that haven't been freed.
- *
- *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
- *      result of calling Tcl_NewStringObj.
- *
- * Results:
- *      A newly created string object is returned that has ref count zero.
- *
- * Side effects:
- *      The new object's internal string representation will be set to a
- *      copy of the length bytes starting at "bytes". If "length" is
- *      negative, use bytes up to the first NULL byte; i.e., assume "bytes"
- *      points to a C-style NULL-terminated string. The object's type is set
- *      to NULL. An extra NULL is added to the end of the new object's byte
- *      array.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewStringObj(bytes, length, file, line)
-    register char *bytes;       /* Points to the first of the length bytes
-                                 * used to initialize the new object. */
-    register int length;        /* The number of bytes to copy from "bytes"
-                                 * when initializing the new object. If 
-                                 * negative, use bytes up to the first
-                                 * NULL byte. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    if (length < 0) {
-        length = (bytes? strlen(bytes) : 0);
-    }
-    TclDbNewObj(objPtr, file, line);
-    TclInitStringRep(objPtr, bytes, length);
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewStringObj(bytes, length, file, line)
-    register char *bytes;       /* Points to the first of the length bytes
-                                 * used to initialize the new object. */
-    register int length;        /* The number of bytes to copy from "bytes"
-                                 * when initializing the new object. If 
-                                 * negative, use bytes up to the first
-                                 * NULL byte. */
-    char *file;                 /* The name of the source file calling this
-                                 * procedure; used for debugging. */
-    int line;                   /* Line number in the source file; used
-                                 * for debugging. */
-{
-    return Tcl_NewStringObj(bytes, length);
-}
-#endif /* TCL_MEM_DEBUG */
 
 

external/tcl/tclVar.c

@@ -711 +711 @@
     char *msg;
 
-#ifdef TCL_COMPILE_DEBUG
-    Proc *procPtr = varFramePtr->procPtr;
-    int localCt = procPtr->numCompiledLocals;
-
-    if (compiledLocals == NULL) {
-        fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x, no compiled locals\n",
-                localIndex, (unsigned int) varFramePtr);
-        panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
-                (unsigned int) varFramePtr);
-    }
-    if ((localIndex < 0) || (localIndex >= localCt)) {
-        fprintf(stderr, "\nTclGetIndexedScalar: can't get local %i in frame 0x%x with %i locals\n",
-                localIndex, (unsigned int) varFramePtr, localCt);
-        panic("TclGetIndexedScalar: bad local index %i in frame 0x%x",
-                localIndex, (unsigned int) varFramePtr);
-    }
-#endif /* TCL_COMPILE_DEBUG */
-    
     varPtr = &(compiledLocals[localIndex]);
     varName = varPtr->name;
@@ -832 +814 @@
     int new;
 
-#ifdef TCL_COMPILE_DEBUG
-    Proc *procPtr = varFramePtr->procPtr;
-    int localCt = procPtr->numCompiledLocals;
-
-    if (compiledLocals == NULL) {
-        fprintf(stderr, "\nTclGetElementOfIndexedArray: can't get element of local %i in frame 0x%x, no compiled locals\n",
-                localIndex, (unsigned int) varFramePtr);
-        panic("TclGetIndexedScalar: no compiled locals in frame 0x%x",
-                (unsigned int) varFramePtr);
-    }
-    if ((localIndex < 0) || (localIndex >= localCt)) {
-        fprintf(stderr, "\nTclGetIndexedScalar: can't get element of local %i in frame 0x%x with %i locals\n",
-                localIndex, (unsigned int) varFramePtr, localCt);
-        panic("TclGetElementOfIndexedArray: bad local index %i in frame 0x%x",
-                localIndex, (unsigned int) varFramePtr);
-    }
-#endif /* TCL_COMPILE_DEBUG */
-
     /*
      * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.
@@ -1449 +1413 @@
     Tcl_Obj *resultPtr = NULL;
 
-#ifdef TCL_COMPILE_DEBUG
-    Proc *procPtr = varFramePtr->procPtr;
-    int localCt = procPtr->numCompiledLocals;
-
-    if (compiledLocals == NULL) {
-        fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x, no compiled locals\n",
-                localIndex, (unsigned int) varFramePtr);
-        panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
-                (unsigned int) varFramePtr);
-    }
-    if ((localIndex < 0) || (localIndex >= localCt)) {
-        fprintf(stderr, "\nTclSetIndexedScalar: can't set local %i in frame 0x%x with %i locals\n",
-                localIndex, (unsigned int) varFramePtr, localCt);
-        panic("TclSetIndexedScalar: bad local index %i in frame 0x%x",
-                localIndex, (unsigned int) varFramePtr);
-    }
-#endif /* TCL_COMPILE_DEBUG */
-    
     varPtr = &(compiledLocals[localIndex]);
     varName = varPtr->name;
@@ -1635 +1581 @@
     int new;
     
-#ifdef TCL_COMPILE_DEBUG
-    Proc *procPtr = varFramePtr->procPtr;
-    int localCt = procPtr->numCompiledLocals;
-
-    if (compiledLocals == NULL) {
-        fprintf(stderr, "\nTclSetElementOfIndexedArray: can't set element of local %i in frame 0x%x, no compiled locals\n",
-                localIndex, (unsigned int) varFramePtr);
-        panic("TclSetIndexedScalar: no compiled locals in frame 0x%x",
-                (unsigned int) varFramePtr);
-    }
-    if ((localIndex < 0) || (localIndex >= localCt)) {
-        fprintf(stderr, "\nTclSetIndexedScalar: can't set elememt of local %i in frame 0x%x with %i locals\n",
-                localIndex, (unsigned int) varFramePtr, localCt);
-        panic("TclSetElementOfIndexedArray: bad local index %i in frame 0x%x",
-                localIndex, (unsigned int) varFramePtr);
-    }
-#endif /* TCL_COMPILE_DEBUG */
-
     /*
      * THIS FAILS IF THE ELEMENT NAME OBJECT'S STRING REP HAS A NULL BYTE.