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