home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclCkalloc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  21.4 KB  |  816 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclCkalloc.c --
  3.  *
  4.  *    Interface to malloc and free that provides support for debugging problems
  5.  *    involving overwritten, double freeing memory and loss of memory.
  6.  *
  7.  * Copyright (c) 1991-1994 The Regents of the University of California.
  8.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * This code contributed by Karl Lehenbauer and Mark Diekhans
  14.  *
  15.  * SCCS: @(#) tclCkalloc.c 1.28 97/04/30 12:09:04
  16.  */
  17.  
  18. #include "tclInt.h"
  19. #include "tclPort.h"
  20.  
  21. #define FALSE    0
  22. #define TRUE    1
  23.  
  24. #ifdef TCL_MEM_DEBUG
  25.  
  26. /*
  27.  * One of the following structures is allocated each time the
  28.  * "memory tag" command is invoked, to hold the current tag.
  29.  */
  30.  
  31. typedef struct MemTag {
  32.     int refCount;        /* Number of mem_headers referencing
  33.                  * this tag. */
  34.     char string[4];        /* Actual size of string will be as
  35.                  * large as needed for actual tag.  This
  36.                  * must be the last field in the structure. */
  37. } MemTag;
  38.  
  39. #define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)
  40.  
  41. static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers
  42.                  * (set by "memory tag" command). */
  43.  
  44. /*
  45.  * One of the following structures is allocated just before each
  46.  * dynamically allocated chunk of memory, both to record information
  47.  * about the chunk and to help detect chunk under-runs.
  48.  */
  49.  
  50. #define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
  51. struct mem_header {
  52.     struct mem_header *flink;
  53.     struct mem_header *blink;
  54.     MemTag *tagPtr;        /* Tag from "memory tag" command;  may be
  55.                  * NULL. */
  56.     char *file;
  57.     long length;
  58.     int line;
  59.     unsigned char low_guard[LOW_GUARD_SIZE];
  60.                 /* Aligns body on 8-byte boundary, plus
  61.                  * provides at least 8 additional guard bytes
  62.                  * to detect underruns. */
  63.     char body[1];        /* First byte of client's space.  Actual
  64.                  * size of this field will be larger than
  65.                  * one. */
  66. };
  67.  
  68. static struct mem_header *allocHead = NULL;  /* List of allocated structures */
  69.  
  70. #define GUARD_VALUE  0141
  71.  
  72. /*
  73.  * The following macro determines the amount of guard space *above* each
  74.  * chunk of memory.
  75.  */
  76.  
  77. #define HIGH_GUARD_SIZE 8
  78.  
  79. /*
  80.  * The following macro computes the offset of the "body" field within
  81.  * mem_header.  It is used to get back to the header pointer from the
  82.  * body pointer that's used by clients.
  83.  */
  84.  
  85. #define BODY_OFFSET \
  86.     ((unsigned long) (&((struct mem_header *) 0)->body))
  87.  
  88. static int total_mallocs = 0;
  89. static int total_frees = 0;
  90. static int current_bytes_malloced = 0;
  91. static int maximum_bytes_malloced = 0;
  92. static int current_malloc_packets = 0;
  93. static int maximum_malloc_packets = 0;
  94. static int break_on_malloc = 0;
  95. static int trace_on_at_malloc = 0;
  96. static int  alloc_tracing = FALSE;
  97. static int  init_malloced_bodies = TRUE;
  98. #ifdef MEM_VALIDATE
  99.     static int  validate_memory = TRUE;
  100. #else
  101.     static int  validate_memory = FALSE;
  102. #endif
  103.  
  104. /*
  105.  * Prototypes for procedures defined in this file:
  106.  */
  107.  
  108. static int        MemoryCmd _ANSI_ARGS_((ClientData clientData,
  109.                 Tcl_Interp *interp, int argc, char **argv));
  110. static void        ValidateMemory _ANSI_ARGS_((
  111.                 struct mem_header *memHeaderP, char *file,
  112.                 int line, int nukeGuards));
  113.  
  114. /*
  115.  *----------------------------------------------------------------------
  116.  *
  117.  * TclDumpMemoryInfo --
  118.  *     Display the global memory management statistics.
  119.  *
  120.  *----------------------------------------------------------------------
  121.  */
  122. void
  123. TclDumpMemoryInfo(outFile) 
  124.     FILE *outFile;
  125. {
  126.         fprintf(outFile,"total mallocs             %10d\n", 
  127.                 total_mallocs);
  128.         fprintf(outFile,"total frees               %10d\n", 
  129.                 total_frees);
  130.         fprintf(outFile,"current packets allocated %10d\n", 
  131.                 current_malloc_packets);
  132.         fprintf(outFile,"current bytes allocated   %10d\n", 
  133.                 current_bytes_malloced);
  134.         fprintf(outFile,"maximum packets allocated %10d\n", 
  135.                 maximum_malloc_packets);
  136.         fprintf(outFile,"maximum bytes allocated   %10d\n", 
  137.                 maximum_bytes_malloced);
  138. }
  139.  
  140. /*
  141.  *----------------------------------------------------------------------
  142.  *
  143.  * ValidateMemory --
  144.  *     Procedure to validate allocted memory guard zones.
  145.  *
  146.  *----------------------------------------------------------------------
  147.  */
  148. static void
  149. ValidateMemory(memHeaderP, file, line, nukeGuards)
  150.     struct mem_header *memHeaderP;
  151.     char              *file;
  152.     int                line;
  153.     int                nukeGuards;
  154. {
  155.     unsigned char *hiPtr;
  156.     int   idx;
  157.     int   guard_failed = FALSE;
  158.     int byte;
  159.     
  160.     for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
  161.         byte = *(memHeaderP->low_guard + idx);
  162.         if (byte != GUARD_VALUE) {
  163.             guard_failed = TRUE;
  164.             fflush(stdout);
  165.         byte &= 0xff;
  166.             fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", idx, byte,
  167.             (isprint(UCHAR(byte)) ? byte : ' '));
  168.         }
  169.     }
  170.     if (guard_failed) {
  171.         TclDumpMemoryInfo (stderr);
  172.         fprintf(stderr, "low guard failed at %lx, %s %d\n",
  173.                  (long unsigned int) memHeaderP->body, file, line);
  174.         fflush(stderr);  /* In case name pointer is bad. */
  175.         fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
  176.         memHeaderP->file, memHeaderP->line);
  177.         panic ("Memory validation failure");
  178.     }
  179.  
  180.     hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
  181.     for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
  182.         byte = *(hiPtr + idx);
  183.         if (byte != GUARD_VALUE) {
  184.             guard_failed = TRUE;
  185.             fflush (stdout);
  186.         byte &= 0xff;
  187.             fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", idx, byte,
  188.             (isprint(UCHAR(byte)) ? byte : ' '));
  189.         }
  190.     }
  191.  
  192.     if (guard_failed) {
  193.         TclDumpMemoryInfo (stderr);
  194.         fprintf(stderr, "high guard failed at %lx, %s %d\n",
  195.                  (long unsigned int) memHeaderP->body, file, line);
  196.         fflush(stderr);  /* In case name pointer is bad. */
  197.         fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
  198.         memHeaderP->length, memHeaderP->file,
  199.         memHeaderP->line);
  200.         panic("Memory validation failure");
  201.     }
  202.  
  203.     if (nukeGuards) {
  204.         memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE); 
  205.         memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE); 
  206.     }
  207.  
  208. }
  209.  
  210. /*
  211.  *----------------------------------------------------------------------
  212.  *
  213.  * Tcl_ValidateAllMemory --
  214.  *     Validates guard regions for all allocated memory.
  215.  *
  216.  *----------------------------------------------------------------------
  217.  */
  218. void
  219. Tcl_ValidateAllMemory (file, line)
  220.     char  *file;
  221.     int    line;
  222. {
  223.     struct mem_header *memScanP;
  224.  
  225.     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
  226.         ValidateMemory(memScanP, file, line, FALSE);
  227.  
  228. }
  229.  
  230. /*
  231.  *----------------------------------------------------------------------
  232.  *
  233.  * Tcl_DumpActiveMemory --
  234.  *     Displays all allocated memory to stderr.
  235.  *
  236.  * Results:
  237.  *     Return TCL_ERROR if an error accessing the file occures, `errno' 
  238.  *     will have the file error number left in it.
  239.  *----------------------------------------------------------------------
  240.  */
  241. int
  242. Tcl_DumpActiveMemory (fileName)
  243.     char *fileName;
  244. {
  245.     FILE              *fileP;
  246.     struct mem_header *memScanP;
  247.     char              *address;
  248.  
  249.     fileP = fopen(fileName, "w");
  250.     if (fileP == NULL)
  251.         return TCL_ERROR;
  252.  
  253.     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
  254.         address = &memScanP->body [0];
  255.         fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
  256.         (long unsigned int) address,
  257.                  (long unsigned int) address + memScanP->length - 1,
  258.          memScanP->length, memScanP->file, memScanP->line,
  259.          (memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
  260.     (void) fputc('\n', fileP);
  261.     }
  262.     fclose (fileP);
  263.     return TCL_OK;
  264. }
  265.  
  266. /*
  267.  *----------------------------------------------------------------------
  268.  *
  269.  * Tcl_DbCkalloc - debugging ckalloc
  270.  *
  271.  *        Allocate the requested amount of space plus some extra for
  272.  *        guard bands at both ends of the request, plus a size, panicing 
  273.  *        if there isn't enough space, then write in the guard bands
  274.  *        and return the address of the space in the middle that the
  275.  *        user asked for.
  276.  *
  277.  *        The second and third arguments are file and line, these contain
  278.  *        the filename and line number corresponding to the caller.
  279.  *        These are sent by the ckalloc macro; it uses the preprocessor
  280.  *        autodefines __FILE__ and __LINE__.
  281.  *
  282.  *----------------------------------------------------------------------
  283.  */
  284. char *
  285. Tcl_DbCkalloc(size, file, line)
  286.     unsigned int size;
  287.     char        *file;
  288.     int          line;
  289. {
  290.     struct mem_header *result;
  291.  
  292.     if (validate_memory)
  293.         Tcl_ValidateAllMemory (file, line);
  294.  
  295.     result = (struct mem_header *) TclpAlloc((unsigned)size + 
  296.                               sizeof(struct mem_header) + HIGH_GUARD_SIZE);
  297.     if (result == NULL) {
  298.         fflush(stdout);
  299.         TclDumpMemoryInfo(stderr);
  300.         panic("unable to alloc %d bytes, %s line %d", size, file, 
  301.               line);
  302.     }
  303.  
  304.     /*
  305.      * Fill in guard zones and size.  Also initialize the contents of
  306.      * the block with bogus bytes to detect uses of initialized data.
  307.      * Link into allocated list.
  308.      */
  309.     if (init_malloced_bodies) {
  310.         memset ((VOID *) result, GUARD_VALUE,
  311.         size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
  312.     } else {
  313.     memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
  314.     memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
  315.     }
  316.     result->length = size;
  317.     result->tagPtr = curTagPtr;
  318.     if (curTagPtr != NULL) {
  319.     curTagPtr->refCount++;
  320.     }
  321.     result->file = file;
  322.     result->line = line;
  323.     result->flink = allocHead;
  324.     result->blink = NULL;
  325.     if (allocHead != NULL)
  326.         allocHead->blink = result;
  327.     allocHead = result;
  328.  
  329.     total_mallocs++;
  330.     if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
  331.         (void) fflush(stdout);
  332.         fprintf(stderr, "reached malloc trace enable point (%d)\n",
  333.                 total_mallocs);
  334.         fflush(stderr);
  335.         alloc_tracing = TRUE;
  336.         trace_on_at_malloc = 0;
  337.     }
  338.  
  339.     if (alloc_tracing)
  340.         fprintf(stderr,"ckalloc %lx %d %s %d\n",
  341.         (long unsigned int) result->body, size, file, line);
  342.  
  343.     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
  344.         break_on_malloc = 0;
  345.         (void) fflush(stdout);
  346.         fprintf(stderr,"reached malloc break limit (%d)\n", 
  347.                 total_mallocs);
  348.         fprintf(stderr, "program will now enter C debugger\n");
  349.         (void) fflush(stderr);
  350.     abort();
  351.     }
  352.  
  353.     current_malloc_packets++;
  354.     if (current_malloc_packets > maximum_malloc_packets)
  355.         maximum_malloc_packets = current_malloc_packets;
  356.     current_bytes_malloced += size;
  357.     if (current_bytes_malloced > maximum_bytes_malloced)
  358.         maximum_bytes_malloced = current_bytes_malloced;
  359.  
  360.     return result->body;
  361. }
  362.  
  363. /*
  364.  *----------------------------------------------------------------------
  365.  *
  366.  * Tcl_DbCkfree - debugging ckfree
  367.  *
  368.  *        Verify that the low and high guards are intact, and if so
  369.  *        then free the buffer else panic.
  370.  *
  371.  *        The guards are erased after being checked to catch duplicate
  372.  *        frees.
  373.  *
  374.  *        The second and third arguments are file and line, these contain
  375.  *        the filename and line number corresponding to the caller.
  376.  *        These are sent by the ckfree macro; it uses the preprocessor
  377.  *        autodefines __FILE__ and __LINE__.
  378.  *
  379.  *----------------------------------------------------------------------
  380.  */
  381.  
  382. int
  383. Tcl_DbCkfree(ptr, file, line)
  384.     char *  ptr;
  385.     char     *file;
  386.     int       line;
  387. {
  388.     /*
  389.      * The following cast is *very* tricky.  Must convert the pointer
  390.      * to an integer before doing arithmetic on it, because otherwise
  391.      * the arithmetic will be done differently (and incorrectly) on
  392.      * word-addressed machines such as Crays (will subtract only bytes,
  393.      * even though BODY_OFFSET is in words on these machines).
  394.      */
  395.  
  396.     struct mem_header *memp = (struct mem_header *)
  397.         (((unsigned long) ptr) - BODY_OFFSET);
  398.  
  399.     if (alloc_tracing)
  400.         fprintf(stderr, "ckfree %lx %ld %s %d\n",
  401.         (long unsigned int) memp->body, memp->length, file, line);
  402.  
  403.     if (validate_memory)
  404.         Tcl_ValidateAllMemory(file, line);
  405.  
  406.     ValidateMemory(memp, file, line, TRUE);
  407.     if (init_malloced_bodies) {
  408.     memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
  409.     }
  410.  
  411.     total_frees++;
  412.     current_malloc_packets--;
  413.     current_bytes_malloced -= memp->length;
  414.  
  415.     if (memp->tagPtr != NULL) {
  416.     memp->tagPtr->refCount--;
  417.     if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
  418.         TclpFree((char *) memp->tagPtr);
  419.     }
  420.     }
  421.  
  422.     /*
  423.      * Delink from allocated list
  424.      */
  425.     if (memp->flink != NULL)
  426.         memp->flink->blink = memp->blink;
  427.     if (memp->blink != NULL)
  428.         memp->blink->flink = memp->flink;
  429.     if (allocHead == memp)
  430.         allocHead = memp->flink;
  431.     TclpFree((char *) memp);
  432.     return 0;
  433. }
  434.  
  435. /*
  436.  *--------------------------------------------------------------------
  437.  *
  438.  * Tcl_DbCkrealloc - debugging ckrealloc
  439.  *
  440.  *    Reallocate a chunk of memory by allocating a new one of the
  441.  *    right size, copying the old data to the new location, and then
  442.  *    freeing the old memory space, using all the memory checking
  443.  *    features of this package.
  444.  *
  445.  *--------------------------------------------------------------------
  446.  */
  447. char *
  448. Tcl_DbCkrealloc(ptr, size, file, line)
  449.     char *ptr;
  450.     unsigned int size;
  451.     char *file;
  452.     int line;
  453. {
  454.     char *new;
  455.     unsigned int copySize;
  456.  
  457.     /*
  458.      * See comment from Tcl_DbCkfree before you change the following
  459.      * line.
  460.      */
  461.  
  462.     struct mem_header *memp = (struct mem_header *)
  463.         (((unsigned long) ptr) - BODY_OFFSET);
  464.  
  465.     copySize = size;
  466.     if (copySize > (unsigned int) memp->length) {
  467.     copySize = memp->length;
  468.     }
  469.     new = Tcl_DbCkalloc(size, file, line);
  470.     memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
  471.     Tcl_DbCkfree(ptr, file, line);
  472.     return(new);
  473. }
  474.  
  475.  
  476. /*
  477.  *----------------------------------------------------------------------
  478.  *
  479.  * Tcl_Alloc, et al. --
  480.  *
  481.  *    These functions are defined in terms of the debugging versions
  482.  *    when TCL_MEM_DEBUG is set.
  483.  *
  484.  * Results:
  485.  *    Same as the debug versions.
  486.  *
  487.  * Side effects:
  488.  *    Same as the debug versions.
  489.  *
  490.  *----------------------------------------------------------------------
  491.  */
  492.  
  493. #undef Tcl_Alloc
  494. #undef Tcl_Free
  495. #undef Tcl_Realloc
  496.  
  497. char *
  498. Tcl_Alloc(size)
  499.     unsigned int size;
  500. {
  501.     return Tcl_DbCkalloc(size, "unknown", 0);
  502. }
  503.  
  504. void
  505. Tcl_Free(ptr)
  506.     char *ptr;
  507. {
  508.     Tcl_DbCkfree(ptr, "unknown", 0);
  509. }
  510.  
  511. char *
  512. Tcl_Realloc(ptr, size)
  513.     char *ptr;
  514.     unsigned int size;
  515. {
  516.     return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
  517. }
  518.  
  519. /*
  520.  *----------------------------------------------------------------------
  521.  *
  522.  * MemoryCmd --
  523.  *     Implements the TCL memory command:
  524.  *       memory info
  525.  *       memory display
  526.  *       break_on_malloc count
  527.  *       trace_on_at_malloc count
  528.  *       trace on|off
  529.  *       validate on|off
  530.  *
  531.  * Results:
  532.  *     Standard TCL results.
  533.  *
  534.  *----------------------------------------------------------------------
  535.  */
  536.     /* ARGSUSED */
  537. static int
  538. MemoryCmd (clientData, interp, argc, argv)
  539.     ClientData  clientData;
  540.     Tcl_Interp *interp;
  541.     int         argc;
  542.     char      **argv;
  543. {
  544.     char *fileName;
  545.     Tcl_DString buffer;
  546.     int result;
  547.  
  548.     if (argc < 2) {
  549.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  550.         argv[0], " option [args..]\"", (char *) NULL);
  551.     return TCL_ERROR;
  552.     }
  553.  
  554.     if (strcmp(argv[1],"active") == 0) {
  555.         if (argc != 3) {
  556.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  557.             argv[0], " active file\"", (char *) NULL);
  558.         return TCL_ERROR;
  559.     }
  560.     fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
  561.     if (fileName == NULL) {
  562.         return TCL_ERROR;
  563.     }
  564.     result = Tcl_DumpActiveMemory (fileName);
  565.     Tcl_DStringFree(&buffer);
  566.     if (result != TCL_OK) {
  567.         Tcl_AppendResult(interp, "error accessing ", argv[2], 
  568.             (char *) NULL);
  569.         return TCL_ERROR;
  570.     }
  571.     return TCL_OK;
  572.     }
  573.     if (strcmp(argv[1],"break_on_malloc") == 0) {
  574.         if (argc != 3) {
  575.             goto argError;
  576.     }
  577.         if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
  578.         return TCL_ERROR;
  579.     }
  580.         return TCL_OK;
  581.     }
  582.     if (strcmp(argv[1],"info") == 0) {
  583.         TclDumpMemoryInfo(stdout);
  584.         return TCL_OK;
  585.     }
  586.     if (strcmp(argv[1],"init") == 0) {
  587.         if (argc != 3) {
  588.             goto bad_suboption;
  589.     }
  590.         init_malloced_bodies = (strcmp(argv[2],"on") == 0);
  591.         return TCL_OK;
  592.     }
  593.     if (strcmp(argv[1],"tag") == 0) {
  594.     if (argc != 3) {
  595.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  596.             " tag string\"", (char *) NULL);
  597.         return TCL_ERROR;
  598.     }
  599.     if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
  600.         TclpFree((char *) curTagPtr);
  601.     }
  602.     curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2])));
  603.     curTagPtr->refCount = 0;
  604.     strcpy(curTagPtr->string, argv[2]);
  605.     return TCL_OK;
  606.     }
  607.     if (strcmp(argv[1],"trace") == 0) {
  608.         if (argc != 3) {
  609.             goto bad_suboption;
  610.     }
  611.         alloc_tracing = (strcmp(argv[2],"on") == 0);
  612.         return TCL_OK;
  613.     }
  614.  
  615.     if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
  616.         if (argc != 3) {
  617.             goto argError;
  618.     }
  619.         if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
  620.         return TCL_ERROR;
  621.     }
  622.     return TCL_OK;
  623.     }
  624.     if (strcmp(argv[1],"validate") == 0) {
  625.         if (argc != 3) {
  626.         goto bad_suboption;
  627.     }
  628.         validate_memory = (strcmp(argv[2],"on") == 0);
  629.         return TCL_OK;
  630.     }
  631.  
  632.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  633.         "\": should be active, break_on_malloc, info, init, ",
  634.         "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
  635.     return TCL_ERROR;
  636.  
  637. argError:
  638.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  639.         " ", argv[1], " count\"", (char *) NULL);
  640.     return TCL_ERROR;
  641.  
  642. bad_suboption:
  643.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  644.         " ", argv[1], " on|off\"", (char *) NULL);
  645.     return TCL_ERROR;
  646. }
  647.  
  648. /*
  649.  *----------------------------------------------------------------------
  650.  *
  651.  * Tcl_InitMemory --
  652.  *     Initialize the memory command.
  653.  *
  654.  *----------------------------------------------------------------------
  655.  */
  656. void
  657. Tcl_InitMemory(interp)
  658.     Tcl_Interp *interp;
  659. {
  660.     Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL, 
  661.         (Tcl_CmdDeleteProc *) NULL);
  662. }
  663.  
  664. #else
  665.  
  666.  
  667. /*
  668.  *----------------------------------------------------------------------
  669.  *
  670.  * Tcl_Alloc --
  671.  *     Interface to TclpAlloc when TCL_MEM_DEBUG is disabled.  It does check
  672.  *     that memory was actually allocated.
  673.  *
  674.  *----------------------------------------------------------------------
  675.  */
  676.  
  677. char *
  678. Tcl_Alloc (size)
  679.     unsigned int size;
  680. {
  681.         char *result;
  682.  
  683.         result = TclpAlloc(size);
  684.         if (result == NULL) 
  685.                 panic("unable to alloc %d bytes", size);
  686.         return result;
  687. }
  688.  
  689. char *
  690. Tcl_DbCkalloc(size, file, line)
  691.     unsigned int size;
  692.     char        *file;
  693.     int          line;
  694. {
  695.     char *result;
  696.  
  697.     result = (char *) TclpAlloc(size);
  698.  
  699.     if (result == NULL) {
  700.         fflush(stdout);
  701.         panic("unable to alloc %d bytes, %s line %d", size, file, 
  702.               line);
  703.     }
  704.     return result;
  705. }
  706.  
  707.  
  708. /*
  709.  *----------------------------------------------------------------------
  710.  *
  711.  * Tcl_Realloc --
  712.  *     Interface to TclpRealloc when TCL_MEM_DEBUG is disabled.  It does 
  713.  *     check that memory was actually allocated.
  714.  *
  715.  *----------------------------------------------------------------------
  716.  */
  717.  
  718. char *
  719. Tcl_Realloc(ptr, size)
  720.     char *ptr;
  721.     unsigned int size;
  722. {
  723.     char *result;
  724.  
  725.     result = TclpRealloc(ptr, size);
  726.     if (result == NULL) 
  727.     panic("unable to realloc %d bytes", size);
  728.     return result;
  729. }
  730.  
  731. char *
  732. Tcl_DbCkrealloc(ptr, size, file, line)
  733.     char *ptr;
  734.     unsigned int size;
  735.     char *file;
  736.     int line;
  737. {
  738.     char *result;
  739.  
  740.     result = (char *) TclpRealloc(ptr, size);
  741.  
  742.     if (result == NULL) {
  743.         fflush(stdout);
  744.         panic("unable to realloc %d bytes, %s line %d", size, file, 
  745.               line);
  746.     }
  747.     return result;
  748. }
  749.  
  750. /*
  751.  *----------------------------------------------------------------------
  752.  *
  753.  * Tcl_Free --
  754.  *     Interface to TclpFree when TCL_MEM_DEBUG is disabled.  Done here
  755.  *     rather in the macro to keep some modules from being compiled with 
  756.  *     TCL_MEM_DEBUG enabled and some with it disabled.
  757.  *
  758.  *----------------------------------------------------------------------
  759.  */
  760.  
  761. void
  762. Tcl_Free (ptr)
  763.     char *ptr;
  764. {
  765.         TclpFree(ptr);
  766. }
  767.  
  768. int
  769. Tcl_DbCkfree(ptr, file, line)
  770.     char *  ptr;
  771.     char     *file;
  772.     int       line;
  773. {
  774.     TclpFree(ptr);
  775.     return 0;
  776. }
  777.  
  778. /*
  779.  *----------------------------------------------------------------------
  780.  *
  781.  * Tcl_InitMemory --
  782.  *     Dummy initialization for memory command, which is only available 
  783.  *     if TCL_MEM_DEBUG is on.
  784.  *
  785.  *----------------------------------------------------------------------
  786.  */
  787.     /* ARGSUSED */
  788. void
  789. Tcl_InitMemory(interp)
  790.     Tcl_Interp *interp;
  791. {
  792. }
  793.  
  794. #undef Tcl_DumpActiveMemory
  795. #undef Tcl_ValidateAllMemory
  796.  
  797. extern int        Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
  798. extern void        Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
  799.                 int line));
  800.  
  801. int
  802. Tcl_DumpActiveMemory(fileName)
  803.     char *fileName;
  804. {
  805.     return TCL_OK;
  806. }
  807.  
  808. void
  809. Tcl_ValidateAllMemory(file, line)
  810.     char  *file;
  811.     int    line;
  812. {
  813. }
  814.  
  815. #endif
  816.