cvs.zerfleddert.de Git - micropolis/blob - src/tcl/tclckall.c

   1 /*
   2  * tclCkalloc.c --
   3  *    Interface to malloc and free that provides support for debugging problems
   4  *    involving overwritten, double freeing memory and loss of memory.
   5  *
   6  * Copyright 1991 Regents of the University of California
   7  * Permission to use, copy, modify, and distribute this
   8  * software and its documentation for any purpose and without
   9  * fee is hereby granted, provided that the above copyright
  10  * notice appear in all copies.  The University of California
  11  * makes no representations about the suitability of this
  12  * software for any purpose.  It is provided "as is" without
  13  * express or implied warranty.
  14  *
  15  * This code contributed by Karl Lehenbauer and Mark Diekhans
  16  *
  17  */
  18
  19 #include "tclint.h"
  20
  21 #define FALSE   0
  22 #define TRUE    1
  23
  24 #ifdef TCL_MEM_DEBUG
  25 #ifndef TCL_GENERIC_ONLY
  26 #include "tclunix.h"
  27 #endif
  28
  29 #define GUARD_SIZE 8
  30
  31 struct mem_header {
  32         long               length;
  33         char              *file;
  34         int                line;
  35         struct mem_header *flink;
  36         struct mem_header *blink;
  37         unsigned char      low_guard[GUARD_SIZE];
  38         char               body[1];
  39 };
  40
  41 static struct mem_header *allocHead = NULL;  /* List of allocated structures */
  42
  43 #define GUARD_VALUE  0341
  44
  45 /* static char high_guard[] = {0x89, 0xab, 0xcd, 0xef}; */
  46
  47 static int total_mallocs = 0;
  48 static int total_frees = 0;
  49 static int current_bytes_malloced = 0;
  50 static int maximum_bytes_malloced = 0;
  51 static int current_malloc_packets = 0;
  52 static int maximum_malloc_packets = 0;
  53 static int break_on_malloc = 0;
  54 static int trace_on_at_malloc = 0;
  55 static int  alloc_tracing = FALSE;
  56 static int  init_malloced_bodies = FALSE;
  57 #ifdef MEM_VALIDATE
  58     static int  validate_memory = TRUE;
  59 #else
  60     static int  validate_memory = FALSE;
  61 #endif
  62
  63 \f
  64 /*
  65  *----------------------------------------------------------------------
  66  *
  67  * dump_memory_info --
  68  *     Display the global memory management statistics.
  69  *
  70  *----------------------------------------------------------------------
  71  */
  72 static void
  73 dump_memory_info (FILE *outFile)
  74 {
  75         fprintf(outFile,"total mallocs             %10d\n",
  76                 total_mallocs);
  77         fprintf(outFile,"total frees               %10d\n",
  78                 total_frees);
  79         fprintf(outFile,"current packets allocated %10d\n",
  80                 current_malloc_packets);
  81         fprintf(outFile,"current bytes allocated   %10d\n",
  82                 current_bytes_malloced);
  83         fprintf(outFile,"maximum packets allocated %10d\n",
  84                 maximum_malloc_packets);
  85         fprintf(outFile,"maximum bytes allocated   %10d\n",
  86                 maximum_bytes_malloced);
  87 }
  88 \f
  89 /*
  90  *----------------------------------------------------------------------
  91  *
  92  * ValidateMemory --
  93  *     Procedure to validate allocted memory guard zones.
  94  *
  95  *----------------------------------------------------------------------
  96  */
  97 static void
  98 ValidateMemory (struct mem_header *memHeaderP, char *file, int line, int nukeGuards)
  99 {
 100     unsigned char *hiPtr;
 101     int   idx;
 102     int   guard_failed = FALSE;
 103
 104     for (idx = 0; idx < GUARD_SIZE; idx++)
 105         if (*(memHeaderP->low_guard + idx) != GUARD_VALUE) {
 106             guard_failed = TRUE;
 107             fflush (stdout);
 108             fprintf(stderr, "low guard byte %d is 0x%x\n", idx,
 109                     *(memHeaderP->low_guard + idx) & 0xff);
 110         }
 111
 112     if (guard_failed) {
 113         dump_memory_info (stderr);
 114         fprintf (stderr, "low guard failed at %lx, %s %d\n",
 115                  memHeaderP->body, file, line);
 116         fflush (stderr);  /* In case name pointer is bad. */
 117         fprintf (stderr, "Allocated at (%s %d)\n", memHeaderP->file,
 118                  memHeaderP->line);
 119         panic ("Memory validation failure");
 120     }
 121
 122     hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
 123     for (idx = 0; idx < GUARD_SIZE; idx++)
 124         if (*(hiPtr + idx) != GUARD_VALUE) {
 125             guard_failed = TRUE;
 126             fflush (stdout);
 127             fprintf(stderr, "hi guard byte %d is 0x%x\n", idx,
 128                     *(hiPtr+idx) & 0xff);
 129         }
 130
 131     if (guard_failed) {
 132         dump_memory_info (stderr);
 133         fprintf (stderr, "high guard failed at %lx, %s %d\n",
 134                  memHeaderP->body, file, line);
 135         fflush (stderr);  /* In case name pointer is bad. */
 136         fprintf (stderr, "Allocated at (%s %d)\n", memHeaderP->file,
 137                  memHeaderP->line);
 138         panic ("Memory validation failure");
 139     }
 140
 141     if (nukeGuards) {
 142         memset ((char *) memHeaderP->low_guard, 0, GUARD_SIZE);
 143         memset ((char *) hiPtr, 0, GUARD_SIZE);
 144     }
 145
 146 }
 147 \f
 148 /*
 149  *----------------------------------------------------------------------
 150  *
 151  * Tcl_ValidateAllMemory --
 152  *     Validates guard regions for all allocated memory.
 153  *
 154  *----------------------------------------------------------------------
 155  */
 156 void
 157 Tcl_ValidateAllMemory (char *file, int line)
 158 {
 159     struct mem_header *memScanP;
 160
 161     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
 162         ValidateMemory (memScanP, file, line, FALSE);
 163
 164 }
 165 \f
 166 /*
 167  *----------------------------------------------------------------------
 168  *
 169  * Tcl_DumpActiveMemory --
 170  *     Displays all allocated memory to stderr.
 171  *
 172  * Results:
 173  *     Return TCL_ERROR if an error accessing the file occures, `errno'
 174  *     will have the file error number left in it.
 175  *----------------------------------------------------------------------
 176  */
 177 int
 178 Tcl_DumpActiveMemory (char *fileName)
 179 {
 180     FILE              *fileP;
 181     struct mem_header *memScanP;
 182     char              *address;
 183
 184 #ifdef MSDOS
 185     fileP = fopen (fileName, "wb");
 186 #else
 187     fileP = fopen (fileName, "w");
 188 #endif
 189     if (fileP == NULL)
 190         return TCL_ERROR;
 191
 192     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
 193         address = &memScanP->body [0];
 194         fprintf (fileP, "%8lx - %8lx  %7d @ %s %d\n", address,
 195                  address + memScanP->length - 1, memScanP->length,
 196                  memScanP->file, memScanP->line);
 197     }
 198     fclose (fileP);
 199     return TCL_OK;
 200 }
 201 \f
 202 /*
 203  *----------------------------------------------------------------------
 204  *
 205  * Tcl_DbCkalloc - debugging ckalloc
 206  *
 207  *        Allocate the requested amount of space plus some extra for
 208  *        guard bands at both ends of the request, plus a size, panicing
 209  *        if there isn't enough space, then write in the guard bands
 210  *        and return the address of the space in the middle that the
 211  *        user asked for.
 212  *
 213  *        The second and third arguments are file and line, these contain
 214  *        the filename and line number corresponding to the caller.
 215  *        These are sent by the ckalloc macro; it uses the preprocessor
 216  *        autodefines __FILE__ and __LINE__.
 217  *
 218  *----------------------------------------------------------------------
 219  */
 220 char *
 221 Tcl_DbCkalloc (unsigned int size, char *file, int line)
 222 {
 223     struct mem_header *result;
 224
 225     if (validate_memory)
 226         Tcl_ValidateAllMemory (file, line);
 227
 228     result = (struct mem_header *)malloc((unsigned)size +
 229                               sizeof(struct mem_header) + GUARD_SIZE);
 230     if (result == NULL) {
 231         fflush(stdout);
 232         dump_memory_info(stderr);
 233         panic("unable to alloc %d bytes, %s line %d", size, file,
 234               line);
 235     }
 236
 237     /*
 238      * Fill in guard zones and size.  Link into allocated list.
 239      */
 240     result->length = size;
 241     result->file = file;
 242     result->line = line;
 243     memset ((char *) result->low_guard, GUARD_VALUE, GUARD_SIZE);
 244     memset (result->body + size, GUARD_VALUE, GUARD_SIZE);
 245     result->flink = allocHead;
 246     result->blink = NULL;
 247     if (allocHead != NULL)
 248         allocHead->blink = result;
 249     allocHead = result;
 250
 251     total_mallocs++;
 252     if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
 253         (void) fflush(stdout);
 254         fprintf(stderr, "reached malloc trace enable point (%d)\n",
 255                 total_mallocs);
 256         fflush(stderr);
 257         alloc_tracing = TRUE;
 258         trace_on_at_malloc = 0;
 259     }
 260
 261     if (alloc_tracing)
 262         fprintf(stderr,"ckalloc %lx %d %s %d\n", result->body, size,
 263                 file, line);
 264
 265     if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
 266         break_on_malloc = 0;
 267         (void) fflush(stdout);
 268         fprintf(stderr,"reached malloc break limit (%d)\n",
 269                 total_mallocs);
 270         fprintf(stderr, "program will now enter C debugger\n");
 271         (void) fflush(stderr);
 272         kill (getpid(), SIGINT);
 273     }
 274
 275     current_malloc_packets++;
 276     if (current_malloc_packets > maximum_malloc_packets)
 277         maximum_malloc_packets = current_malloc_packets;
 278     current_bytes_malloced += size;
 279     if (current_bytes_malloced > maximum_bytes_malloced)
 280         maximum_bytes_malloced = current_bytes_malloced;
 281
 282     if (init_malloced_bodies)
 283         memset (result->body, 0xff, (int) size);
 284
 285     return result->body;
 286 }
 287 \f
 288 /*
 289  *----------------------------------------------------------------------
 290  *
 291  * Tcl_DbCkfree - debugging ckfree
 292  *
 293  *        Verify that the low and high guards are intact, and if so
 294  *        then free the buffer else panic.
 295  *
 296  *        The guards are erased after being checked to catch duplicate
 297  *        frees.
 298  *
 299  *        The second and third arguments are file and line, these contain
 300  *        the filename and line number corresponding to the caller.
 301  *        These are sent by the ckfree macro; it uses the preprocessor
 302  *        autodefines __FILE__ and __LINE__.
 303  *
 304  *----------------------------------------------------------------------
 305  */
 306
 307 int
 308 Tcl_DbCkfree (char *ptr, char *file, int line)
 309 {
 310     struct mem_header *memp = 0;  /* Must be zero for size calc */
 311
 312     /*
 313      * Since header ptr is zero, body offset will be size
 314      */
 315     memp = (struct mem_header *)(((char *) ptr) - (int)memp->body);
 316
 317     if (alloc_tracing)
 318         fprintf(stderr, "ckfree %lx %ld %s %d\n", memp->body,
 319                 memp->length, file, line);
 320
 321     if (validate_memory)
 322         Tcl_ValidateAllMemory (file, line);
 323
 324     ValidateMemory (memp, file, line, TRUE);
 325
 326     total_frees++;
 327     current_malloc_packets--;
 328     current_bytes_malloced -= memp->length;
 329
 330     /*
 331      * Delink from allocated list
 332      */
 333     if (memp->flink != NULL)
 334         memp->flink->blink = memp->blink;
 335     if (memp->blink != NULL)
 336         memp->blink->flink = memp->flink;
 337     if (allocHead == memp)
 338         allocHead = memp->flink;
 339     free((char *) memp);
 340     return 0;
 341 }
 342 \f
 343 /*
 344  *----------------------------------------------------------------------
 345  *
 346  * MemoryCmd --
 347  *     Implements the TCL memory command:
 348  *       memory info
 349  *       memory display
 350  *       break_on_malloc count
 351  *       trace_on_at_malloc count
 352  *       trace on|off
 353  *       validate on|off
 354  *
 355  * Results:
 356  *     Standard TCL results.
 357  *
 358  *----------------------------------------------------------------------
 359  */
 360         /* ARGSUSED */
 361 static int
 362 MemoryCmd (char *clientData, Tcl_Interp *interp, int argc, char **argv)
 363 {
 364     char *fileName;
 365
 366     if (argc < 2) {
 367         Tcl_AppendResult(interp, "wrong # args:  should be \"",
 368                 argv[0], " option [args..]\"", (char *) NULL);
 369         return TCL_ERROR;
 370     }
 371
 372     if (strcmp(argv[1],"trace") == 0) {
 373         if (argc != 3)
 374             goto bad_suboption;
 375         alloc_tracing = (strcmp(argv[2],"on") == 0);
 376         return TCL_OK;
 377     }
 378     if (strcmp(argv[1],"init") == 0) {
 379         if (argc != 3)
 380             goto bad_suboption;
 381         init_malloced_bodies = (strcmp(argv[2],"on") == 0);
 382         return TCL_OK;
 383     }
 384     if (strcmp(argv[1],"validate") == 0) {
 385         if (argc != 3)
 386              goto bad_suboption;
 387         validate_memory = (strcmp(argv[2],"on") == 0);
 388         return TCL_OK;
 389     }
 390     if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
 391         if (argc != 3)
 392             goto argError;
 393         if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK)
 394                 return TCL_ERROR;
 395          return TCL_OK;
 396     }
 397     if (strcmp(argv[1],"break_on_malloc") == 0) {
 398         if (argc != 3)
 399             goto argError;
 400         if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK)
 401                 return TCL_ERROR;
 402         return TCL_OK;
 403     }
 404
 405     if (strcmp(argv[1],"info") == 0) {
 406         dump_memory_info(stdout);
 407         return TCL_OK;
 408     }
 409     if (strcmp(argv[1],"active") == 0) {
 410         if (argc != 3) {
 411             Tcl_AppendResult(interp, "wrong # args:  should be \"",
 412                     argv[0], " active file", (char *) NULL);
 413             return TCL_ERROR;
 414         }
 415         fileName = argv [2];
 416         if (fileName [0] == '~')
 417             if ((fileName = Tcl_TildeSubst (interp, fileName)) == NULL)
 418                 return TCL_ERROR;
 419         if (Tcl_DumpActiveMemory (fileName) != TCL_OK) {
 420             Tcl_AppendResult(interp, "error accessing ", argv[2],
 421                     (char *) NULL);
 422             return TCL_ERROR;
 423         }
 424         return TCL_OK;
 425     }
 426     Tcl_AppendResult(interp, "bad option \"", argv[1],
 427             "\":  should be info, init, active, break_on_malloc, ",
 428             "trace_on_at_malloc, trace, or validate", (char *) NULL);
 429     return TCL_ERROR;
 430
 431 argError:
 432     Tcl_AppendResult(interp, "wrong # args:  should be \"", argv[0],
 433             " ", argv[1], "count\"", (char *) NULL);
 434     return TCL_ERROR;
 435
 436 bad_suboption:
 437     Tcl_AppendResult(interp, "wrong # args:  should be \"", argv[0],
 438             " ", argv[1], " on|off\"", (char *) NULL);
 439     return TCL_ERROR;
 440 }
 441 \f
 442 /*
 443  *----------------------------------------------------------------------
 444  *
 445  * Tcl_InitMemory --
 446  *     Initialize the memory command.
 447  *
 448  *----------------------------------------------------------------------
 449  */
 450 void
 451 Tcl_InitMemory (Tcl_Interp *interp)
 452 {
 453 Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData)NULL,
 454                   (void (*)())NULL);
 455 }
 456
 457 #else
 458
 459 \f
 460 /*
 461  *----------------------------------------------------------------------
 462  *
 463  * Tcl_Ckalloc --
 464  *     Interface to malloc when TCL_MEM_DEBUG is disabled.  It does check
 465  *     that memory was actually allocated.
 466  *
 467  *----------------------------------------------------------------------
 468  */
 469 VOID *
 470 Tcl_Ckalloc (unsigned int size)
 471 {
 472         char *result;
 473
 474         result = malloc(size);
 475         if (result == NULL)
 476                 panic("unable to alloc %d bytes", size);
 477         return result;
 478 }
 479 \f
 480 /*
 481  *----------------------------------------------------------------------
 482  *
 483  * TckCkfree --
 484  *     Interface to free when TCL_MEM_DEBUG is disabled.  Done here rather
 485  *     in the macro to keep some modules from being compiled with
 486  *     TCL_MEM_DEBUG enabled and some with it disabled.
 487  *
 488  *----------------------------------------------------------------------
 489  */
 490 void
 491 Tcl_Ckfree (VOID *ptr)
 492 {
 493         free (ptr);
 494 }
 495 \f
 496 /*
 497  *----------------------------------------------------------------------
 498  *
 499  * Tcl_InitMemory --
 500  *     Dummy initialization for memory command, which is only available
 501  *     if TCL_MEM_DEBUG is on.
 502  *
 503  *----------------------------------------------------------------------
 504  */
 505         /* ARGSUSED */
 506 void
 507 Tcl_InitMemory (Tcl_Interp *interp)
 508 {
 509 }
 510
 511 #endif