Return to tclckall.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tcl

Annotation of micropolis/src/tcl/tclckall.c, revision 1.1

1.1     ! root        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: 
        !            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: 
        !            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: 
        !           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: 
        !           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: 
        !           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: 
        !           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: 
        !           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: 
        !           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: 
        !           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: 
        !           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: 
        !           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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.