Back to index

lightning-sunbird  0.9+nobinonly
misc.c
Go to the documentation of this file.
00001 /* 
00002  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
00003  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
00004  *
00005  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
00006  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
00007  *
00008  * Permission is hereby granted to use or copy this program
00009  * for any purpose,  provided the above notices are retained on all copies.
00010  * Permission to modify the code and to distribute modified code is granted,
00011  * provided the above notices are retained, and a notice that the code was
00012  * modified is included with the above copyright notice.
00013  */
00014 /* Boehm, July 31, 1995 5:02 pm PDT */
00015 
00016 
00017 #include <stdio.h>
00018 #include <signal.h>
00019 
00020 #define I_HIDE_POINTERS     /* To make GC_call_with_alloc_lock visible */
00021 #include "gc_priv.h"
00022 
00023 #ifdef SOLARIS_THREADS
00024 # include <sys/syscall.h>
00025 #endif
00026 #ifdef MSWIN32
00027 # include <windows.h>
00028 #endif
00029 
00030 # ifdef THREADS
00031 #   ifdef PCR
00032 #     include "il/PCR_IL.h"
00033       PCR_Th_ML GC_allocate_ml;
00034 #   else
00035 #     if defined(SRC_M3) || defined(GENERIC_THREADS)
00036        /* Critical section counter is defined in the M3 runtime       */
00037        /* That's all we use.                                          */
00038 #     else
00039 #      ifdef SOLARIS_THREADS
00040          mutex_t GC_allocate_ml;   /* Implicitly initialized.  */
00041 #      else
00042 #          ifdef WIN32_THREADS
00043 /*           GC_API CRITICAL_SECTION GC_allocate_ml;   */ /* uh, GC_API makes it extern */
00044              CRITICAL_SECTION GC_allocate_ml;
00045 #          else
00046 #             if defined(IRIX_THREADS) || defined(LINUX_THREADS) \
00047                || defined(IRIX_JDK_THREADS)
00048 #             ifdef UNDEFINED
00049                   pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER;
00050 #             endif
00051                pthread_t GC_lock_holder = NO_THREAD;
00052 #            else
00053                --> declare allocator lock here
00054 #            endif
00055 #         endif
00056 #      endif
00057 #     endif
00058 #   endif
00059 # endif
00060 
00061 GC_FAR struct _GC_arrays GC_arrays /* = { 0 } */;
00062 
00063 
00064 GC_bool GC_debugging_started = FALSE;
00065        /* defined here so we don't have to load debug_malloc.o */
00066 
00067 void (*GC_check_heap)() = (void (*)())0;
00068 
00069 void (*GC_start_call_back)() = (void (*)())0;
00070 
00071 ptr_t GC_stackbottom = 0;
00072 
00073 GC_bool GC_dont_gc = 0;
00074 
00075 GC_bool GC_quiet = 0;
00076 
00077 /*ARGSUSED*/
00078 GC_PTR GC_default_oom_fn GC_PROTO((size_t bytes_requested))
00079 {
00080     return(0);
00081 }
00082 
00083 GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested)) = GC_default_oom_fn;
00084 
00085 extern signed_word GC_mem_found;
00086 
00087 # ifdef MERGE_SIZES
00088     /* Set things up so that GC_size_map[i] >= words(i),              */
00089     /* but not too much bigger                                        */
00090     /* and so that size_map contains relatively few distinct entries  */
00091     /* This is stolen from Russ Atkinson's Cedar quantization         */
00092     /* alogrithm (but we precompute it).                       */
00093 
00094 
00095     void GC_init_size_map()
00096     {
00097        register unsigned i;
00098 
00099        /* Map size 0 to 1.  This avoids problems at lower levels. */
00100          GC_size_map[0] = 1;
00101        /* One word objects don't have to be 2 word aligned.       */
00102          for (i = 1; i < sizeof(word); i++) {
00103              GC_size_map[i] = 1;
00104          }
00105          GC_size_map[sizeof(word)] = ROUNDED_UP_WORDS(sizeof(word));
00106        for (i = sizeof(word) + 1; i <= 8 * sizeof(word); i++) {
00107 #           ifdef ALIGN_DOUBLE
00108              GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
00109 #           else
00110              GC_size_map[i] = ROUNDED_UP_WORDS(i);
00111 #           endif
00112        }
00113        for (i = 8*sizeof(word) + 1; i <= 16 * sizeof(word); i++) {
00114              GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
00115        }
00116        /* We leave the rest of the array to be filled in on demand. */
00117     }
00118     
00119     /* Fill in additional entries in GC_size_map, including the ith one */
00120     /* We assume the ith entry is currently 0.                        */
00121     /* Note that a filled in section of the array ending at n always    */
00122     /* has length at least n/4.                                       */
00123     void GC_extend_size_map(i)
00124     word i;
00125     {
00126         word orig_word_sz = ROUNDED_UP_WORDS(i);
00127         word word_sz = orig_word_sz;
00128        register word byte_sz = WORDS_TO_BYTES(word_sz);
00129                             /* The size we try to preserve.           */
00130                             /* Close to to i, unless this would       */
00131                             /* introduce too many distinct sizes.     */
00132        word smaller_than_i = byte_sz - (byte_sz >> 3);
00133        word much_smaller_than_i = byte_sz - (byte_sz >> 2);
00134        register word low_limit;    /* The lowest indexed entry we     */
00135                                    /* initialize.                     */
00136        register word j;
00137        
00138        if (GC_size_map[smaller_than_i] == 0) {
00139            low_limit = much_smaller_than_i;
00140            while (GC_size_map[low_limit] != 0) low_limit++;
00141        } else {
00142            low_limit = smaller_than_i + 1;
00143            while (GC_size_map[low_limit] != 0) low_limit++;
00144            word_sz = ROUNDED_UP_WORDS(low_limit);
00145            word_sz += word_sz >> 3;
00146            if (word_sz < orig_word_sz) word_sz = orig_word_sz;
00147        }
00148 #      ifdef ALIGN_DOUBLE
00149            word_sz += 1;
00150            word_sz &= ~1;
00151 #      endif
00152        if (word_sz > MAXOBJSZ) {
00153            word_sz = MAXOBJSZ;
00154        }
00155        /* If we can fit the same number of larger objects in a block, */
00156        /* do so.                                               */ 
00157        {
00158            size_t number_of_objs = BODY_SZ/word_sz;
00159            word_sz = BODY_SZ/number_of_objs;
00160 #          ifdef ALIGN_DOUBLE
00161               word_sz &= ~1;
00162 #          endif
00163        }
00164        byte_sz = WORDS_TO_BYTES(word_sz);
00165 #      ifdef ADD_BYTE_AT_END
00166            /* We need one extra byte; don't fill in GC_size_map[byte_sz] */
00167            byte_sz--;
00168 #      endif
00169 
00170        for (j = low_limit; j <= byte_sz; j++) GC_size_map[j] = word_sz;  
00171     }
00172 # endif
00173 
00174 
00175 /*
00176  * The following is a gross hack to deal with a problem that can occur
00177  * on machines that are sloppy about stack frame sizes, notably SPARC.
00178  * Bogus pointers may be written to the stack and not cleared for
00179  * a LONG time, because they always fall into holes in stack frames
00180  * that are not written.  We partially address this by clearing
00181  * sections of the stack whenever we get control.
00182  */
00183 word GC_stack_last_cleared = 0;    /* GC_no when we last did this */
00184 # ifdef THREADS
00185 #   define CLEAR_SIZE 2048
00186 # else
00187 #   define CLEAR_SIZE 213
00188 # endif
00189 # define DEGRADE_RATE 50
00190 
00191 word GC_min_sp;             /* Coolest stack pointer value from which we've */
00192                      /* already cleared the stack.                    */
00193                      
00194 # ifdef STACK_GROWS_DOWN
00195 #   define COOLER_THAN >
00196 #   define HOTTER_THAN <
00197 #   define MAKE_COOLER(x,y) if ((word)(x)+(y) > (word)(x)) {(x) += (y);} \
00198                          else {(x) = (word)ONES;}
00199 #   define MAKE_HOTTER(x,y) (x) -= (y)
00200 # else
00201 #   define COOLER_THAN <
00202 #   define HOTTER_THAN >
00203 #   define MAKE_COOLER(x,y) if ((word)(x)-(y) < (word)(x)) {(x) -= (y);} else {(x) = 0;}
00204 #   define MAKE_HOTTER(x,y) (x) += (y)
00205 # endif
00206 
00207 word GC_high_water;
00208                      /* "hottest" stack pointer value we have seen    */
00209                      /* recently.  Degrades over time.         */
00210 
00211 word GC_words_allocd_at_reset;
00212 
00213 #if defined(ASM_CLEAR_CODE) && !defined(THREADS)
00214   extern ptr_t GC_clear_stack_inner();
00215 #endif  
00216 
00217 #if !defined(ASM_CLEAR_CODE) && !defined(THREADS)
00218 /* Clear the stack up to about limit.  Return arg. */
00219 /*ARGSUSED*/
00220 ptr_t GC_clear_stack_inner(arg, limit)
00221 ptr_t arg;
00222 word limit;
00223 {
00224     word dummy[CLEAR_SIZE];
00225     
00226     BZERO(dummy, CLEAR_SIZE*sizeof(word));
00227     if ((word)(dummy) COOLER_THAN limit) {
00228         (void) GC_clear_stack_inner(arg, limit);
00229     }
00230     /* Make sure the recursive call is not a tail call, and the bzero */
00231     /* call is not recognized as dead code.                           */
00232     GC_noop1((word)dummy);
00233     return(arg);
00234 }
00235 #endif
00236 
00237 /* Clear some of the inaccessible part of the stack.  Returns its     */
00238 /* argument, so it can be used in a tail call position, hence clearing  */
00239 /* another frame.                                              */
00240 ptr_t GC_clear_stack(arg)
00241 ptr_t arg;
00242 {
00243     register word sp = (word)GC_approx_sp();  /* Hotter than actual sp */
00244 #   ifdef THREADS
00245         word dummy[CLEAR_SIZE];
00246 #   else
00247        register word limit;
00248 #   endif
00249     
00250 #   define SLOP 400
00251        /* Extra bytes we clear every time.  This clears our own       */
00252        /* activation record, and should cause more frequent           */
00253        /* clearing near the cold end of the stack, a good thing.      */
00254 #   define GC_SLOP 4000
00255        /* We make GC_high_water this much hotter than we really saw          */
00256        /* saw it, to cover for GC noise etc. above our current frame. */
00257 #   define CLEAR_THRESHOLD 100000
00258        /* We restart the clearing process after this many bytes of    */
00259        /* allocation.  Otherwise very heavily recursive programs      */
00260        /* with sparse stacks may result in heaps that grow almost     */
00261        /* without bounds.  As the heap gets larger, collection        */
00262        /* frequency decreases, thus clearing frequency would decrease, */
00263        /* thus more junk remains accessible, thus the heap gets       */
00264        /* larger ...                                           */
00265 # ifdef THREADS
00266     BZERO(dummy, CLEAR_SIZE*sizeof(word));
00267 # else
00268     if (GC_gc_no > GC_stack_last_cleared) {
00269         /* Start things over, so we clear the entire stack again */
00270         if (GC_stack_last_cleared == 0) GC_high_water = (word) GC_stackbottom;
00271         GC_min_sp = GC_high_water;
00272         GC_stack_last_cleared = GC_gc_no;
00273         GC_words_allocd_at_reset = GC_words_allocd;
00274     }
00275     /* Adjust GC_high_water */
00276         MAKE_COOLER(GC_high_water, WORDS_TO_BYTES(DEGRADE_RATE) + GC_SLOP);
00277         if (sp HOTTER_THAN GC_high_water) {
00278             GC_high_water = sp;
00279         }
00280         MAKE_HOTTER(GC_high_water, GC_SLOP);
00281     limit = GC_min_sp;
00282     MAKE_HOTTER(limit, SLOP);
00283     if (sp COOLER_THAN limit) {
00284         limit &= ~0xf;      /* Make it sufficiently aligned for assembly     */
00285                      /* implementations of GC_clear_stack_inner.      */
00286         GC_min_sp = sp;
00287         return(GC_clear_stack_inner(arg, limit));
00288     } else if (WORDS_TO_BYTES(GC_words_allocd - GC_words_allocd_at_reset)
00289               > CLEAR_THRESHOLD) {
00290        /* Restart clearing process, but limit how much clearing we do. */
00291        GC_min_sp = sp;
00292        MAKE_HOTTER(GC_min_sp, CLEAR_THRESHOLD/4);
00293        if (GC_min_sp HOTTER_THAN GC_high_water) GC_min_sp = GC_high_water;
00294        GC_words_allocd_at_reset = GC_words_allocd;
00295     }  
00296 # endif
00297   return(arg);
00298 }
00299 
00300 
00301 /* Return a pointer to the base address of p, given a pointer to a    */
00302 /* an address within an object.  Return 0 o.w.                        */
00303 # ifdef __STDC__
00304     GC_PTR GC_base(GC_PTR p)
00305 # else
00306     GC_PTR GC_base(p)
00307     GC_PTR p;
00308 # endif
00309 {
00310     register word r;
00311     register struct hblk *h;
00312     register bottom_index *bi;
00313     register hdr *candidate_hdr;
00314     register word limit;
00315     
00316     r = (word)p;
00317     if (!GC_is_initialized) return 0;
00318     h = HBLKPTR(r);
00319     GET_BI(r, bi);
00320     candidate_hdr = HDR_FROM_BI(bi, r);
00321     if (candidate_hdr == 0) return(0);
00322     /* If it's a pointer to the middle of a large object, move it     */
00323     /* to the beginning.                                       */
00324        while (IS_FORWARDING_ADDR_OR_NIL(candidate_hdr)) {
00325           h = FORWARDED_ADDR(h,candidate_hdr);
00326           r = (word)h + HDR_BYTES;
00327           candidate_hdr = HDR(h);
00328        }
00329     if (candidate_hdr -> hb_map == GC_invalid_map) return(0);
00330     /* Make sure r points to the beginning of the object */
00331        r &= ~(WORDS_TO_BYTES(1) - 1);
00332         {
00333            register int offset = (char *)r - (char *)(HBLKPTR(r));
00334            register signed_word sz = candidate_hdr -> hb_sz;
00335            
00336 #          ifdef ALL_INTERIOR_POINTERS
00337              register map_entry_type map_entry;
00338              
00339              map_entry = MAP_ENTRY((candidate_hdr -> hb_map), offset);
00340              if (map_entry == OBJ_INVALID) {
00341               return(0);
00342               }
00343               r -= WORDS_TO_BYTES(map_entry);
00344               limit = r + WORDS_TO_BYTES(sz);
00345 #          else
00346              register int correction;
00347              
00348              offset = BYTES_TO_WORDS(offset - HDR_BYTES);
00349              correction = offset % sz;
00350              r -= (WORDS_TO_BYTES(correction));
00351              limit = r + WORDS_TO_BYTES(sz);
00352              if (limit > (word)(h + 1)
00353                && sz <= BYTES_TO_WORDS(HBLKSIZE) - HDR_WORDS) {
00354                return(0);
00355              }
00356 #          endif
00357            if ((word)p >= limit) return(0);
00358        }
00359     return((GC_PTR)r);
00360 }
00361 
00362 
00363 /* Return the size of an object, given a pointer to its base.         */
00364 /* (For small obects this also happens to work from interior pointers,       */
00365 /* but that shouldn't be relied upon.)                                */
00366 # ifdef __STDC__
00367     size_t GC_size(GC_PTR p)
00368 # else
00369     size_t GC_size(p)
00370     GC_PTR p;
00371 # endif
00372 {
00373     register int sz;
00374     register hdr * hhdr = HDR(p);
00375     
00376     sz = WORDS_TO_BYTES(hhdr -> hb_sz);
00377     if (sz < 0) {
00378         return(-sz);
00379     } else {
00380         return(sz);
00381     }
00382 }
00383 
00384 size_t GC_get_heap_size GC_PROTO(())
00385 {
00386     return ((size_t) GC_heapsize);
00387 }
00388 
00389 size_t GC_get_bytes_since_gc GC_PROTO(())
00390 {
00391     return ((size_t) WORDS_TO_BYTES(GC_words_allocd));
00392 }
00393 
00394 GC_bool GC_is_initialized = FALSE;
00395 
00396 void GC_init()
00397 {
00398     DCL_LOCK_STATE;
00399     
00400     DISABLE_SIGNALS();
00401     LOCK();
00402     GC_init_inner();
00403     UNLOCK();
00404     ENABLE_SIGNALS();
00405 
00406 }
00407 
00408 #ifdef MACOS
00409     extern void GC_init_MacOS();
00410 #endif
00411 
00412 #ifdef MSWIN32
00413     extern void GC_init_win32();
00414 #endif
00415 
00416 extern void GC_setpagesize();
00417 
00418 void GC_init_inner()
00419 {
00420 #   ifndef THREADS
00421         word dummy;
00422 #   endif
00423     
00424     if (GC_is_initialized) return;
00425     GC_setpagesize();
00426     GC_exclude_static_roots(beginGC_arrays, end_gc_area);
00427 #   ifdef PRINTSTATS
00428        if ((ptr_t)endGC_arrays != (ptr_t)(&GC_obj_kinds)) {
00429            GC_printf0("Reordering linker, didn't exclude obj_kinds\n");
00430        }
00431 #   endif
00432 #   ifdef MACOS
00433     GC_init_MacOS();
00434 #   endif
00435 #   ifdef MSWIN32
00436        GC_init_win32();
00437 #   endif
00438 #   if defined(LINUX) && defined(POWERPC)
00439        GC_init_linuxppc();
00440 #   endif
00441 #   if defined(LINUX) && defined(SPARC)
00442        GC_init_linuxsparc();
00443 #   endif
00444 #   ifdef SOLARIS_THREADS
00445        GC_thr_init();
00446        /* We need dirty bits in order to find live stack sections.    */
00447         GC_dirty_init();
00448 #   endif
00449 #   if defined(IRIX_THREADS) || defined(LINUX_THREADS) \
00450        || defined(IRIX_JDK_THREADS)
00451         GC_thr_init();
00452 #   endif
00453 #   if !defined(THREADS) || defined(SOLARIS_THREADS) || defined(WIN32_THREADS) \
00454        || defined(IRIX_THREADS) || defined(LINUX_THREADS) || defined(GENERIC_THREADS)
00455       if (GC_stackbottom == 0) {
00456        GC_stackbottom = GC_get_stack_base();
00457       }
00458 #   endif
00459     if  (sizeof (ptr_t) != sizeof(word)) {
00460         ABORT("sizeof (ptr_t) != sizeof(word)\n");
00461     }
00462     if  (sizeof (signed_word) != sizeof(word)) {
00463         ABORT("sizeof (signed_word) != sizeof(word)\n");
00464     }
00465     if  (sizeof (struct hblk) != HBLKSIZE) {
00466         ABORT("sizeof (struct hblk) != HBLKSIZE\n");
00467     }
00468 #   ifndef THREADS
00469 #     if defined(STACK_GROWS_UP) && defined(STACK_GROWS_DOWN)
00470        ABORT(
00471          "Only one of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
00472 #     endif
00473 #     if !defined(STACK_GROWS_UP) && !defined(STACK_GROWS_DOWN)
00474        ABORT(
00475          "One of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
00476 #     endif
00477 #     ifdef STACK_GROWS_DOWN
00478         if ((word)(&dummy) > (word)GC_stackbottom) {
00479           GC_err_printf0(
00480               "STACK_GROWS_DOWN is defd, but stack appears to grow up\n");
00481 #        ifndef UTS4  /* Compiler bug workaround */
00482             GC_err_printf2("sp = 0x%lx, GC_stackbottom = 0x%lx\n",
00483                         (unsigned long) (&dummy),
00484                         (unsigned long) GC_stackbottom);
00485 #        endif
00486           ABORT("stack direction 3\n");
00487         }
00488 #     else
00489         if ((word)(&dummy) < (word)GC_stackbottom) {
00490           GC_err_printf0(
00491               "STACK_GROWS_UP is defd, but stack appears to grow down\n");
00492           GC_err_printf2("sp = 0x%lx, GC_stackbottom = 0x%lx\n",
00493                              (unsigned long) (&dummy),
00494                       (unsigned long) GC_stackbottom);
00495           ABORT("stack direction 4");
00496         }
00497 #     endif
00498 #   endif
00499 #   if !defined(_AUX_SOURCE) || defined(__GNUC__)
00500       if ((word)(-1) < (word)0) {
00501        GC_err_printf0("The type word should be an unsigned integer type\n");
00502        GC_err_printf0("It appears to be signed\n");
00503        ABORT("word");
00504       }
00505 #   endif
00506     if ((signed_word)(-1) >= (signed_word)0) {
00507        GC_err_printf0(
00508               "The type signed_word should be a signed integer type\n");
00509        GC_err_printf0("It appears to be unsigned\n");
00510        ABORT("signed_word");
00511     }
00512     
00513     /* Add initial guess of root sets.  Do this first, since sbrk(0)  */
00514     /* might be used.                                                 */
00515       GC_register_data_segments();
00516     GC_init_headers();
00517     GC_bl_init();
00518     GC_mark_init();
00519     if (!GC_expand_hp_inner((word)MINHINCR)) {
00520         GC_err_printf0("Can't start up: not enough memory\n");
00521         EXIT();
00522     }
00523     /* Preallocate large object map.  It's otherwise inconvenient to  */
00524     /* deal with failure.                                      */
00525       if (!GC_add_map_entry((word)0)) {
00526         GC_err_printf0("Can't start up: not enough memory\n");
00527         EXIT();
00528       }
00529     GC_register_displacement_inner(0L);
00530 #   ifdef MERGE_SIZES
00531       GC_init_size_map();
00532 #   endif
00533 #   ifdef PCR
00534       if (PCR_IL_Lock(PCR_Bool_false, PCR_allSigsBlocked, PCR_waitForever)
00535           != PCR_ERes_okay) {
00536           ABORT("Can't lock load state\n");
00537       } else if (PCR_IL_Unlock() != PCR_ERes_okay) {
00538           ABORT("Can't unlock load state\n");
00539       }
00540       PCR_IL_Unlock();
00541       GC_pcr_install();
00542 #   endif
00543     /* Get black list set up */
00544       GC_gcollect_inner();
00545 #   ifdef STUBBORN_ALLOC
00546        GC_stubborn_init();
00547 #   endif
00548     GC_is_initialized = TRUE;
00549     /* Convince lint that some things are used */
00550 #   ifdef LINT
00551       {
00552           extern char * GC_copyright[];
00553           extern int GC_read();
00554           extern void GC_register_finalizer_no_order();
00555           
00556           GC_noop(GC_copyright, GC_find_header,
00557                   GC_push_one, GC_call_with_alloc_lock, GC_read,
00558                   GC_dont_expand,
00559 #               ifndef NO_DEBUGGING
00560                   GC_dump,
00561 #               endif
00562                   GC_register_finalizer_no_order);
00563       }
00564 #   endif
00565 }
00566 
00567 void GC_enable_incremental GC_PROTO(())
00568 {
00569 # if  !defined(FIND_LEAK) && !defined(SMALL_CONFIG)
00570     DCL_LOCK_STATE;
00571     
00572     DISABLE_SIGNALS();
00573     LOCK();
00574     if (GC_incremental) goto out;
00575     GC_setpagesize();
00576 #   ifdef MSWIN32
00577       {
00578         extern GC_bool GC_is_win32s();
00579 
00580        /* VirtualProtect is not functional under win32s.       */
00581        if (GC_is_win32s()) goto out;
00582       }
00583 #   endif /* MSWIN32 */
00584 #   ifndef SOLARIS_THREADS
00585         GC_dirty_init();
00586 #   endif
00587     if (!GC_is_initialized) {
00588         GC_init_inner();
00589     }
00590     if (GC_dont_gc) {
00591         /* Can't easily do it. */
00592         UNLOCK();
00593        ENABLE_SIGNALS();
00594        return;
00595     }
00596     if (GC_words_allocd > 0) {
00597        /* There may be unmarked reachable objects       */
00598        GC_gcollect_inner();
00599     }   /* else we're OK in assuming everything's       */
00600        /* clean since nothing can point to an           */
00601        /* unmarked object.                       */
00602     GC_read_dirty();
00603     GC_incremental = TRUE;
00604 out:
00605     UNLOCK();
00606     ENABLE_SIGNALS();
00607 # endif
00608 }
00609 
00610 
00611 #ifdef MSWIN32
00612 # define LOG_FILE "gc.log"
00613 
00614   HANDLE GC_stdout = 0, GC_stderr;
00615   int GC_tmp;
00616   DWORD GC_junk;
00617 
00618   void GC_set_files()
00619   {
00620     if (!GC_stdout) {
00621         GC_stdout = CreateFile(LOG_FILE, GENERIC_WRITE,
00622                             FILE_SHARE_READ | FILE_SHARE_WRITE,
00623                             NULL, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH,
00624                             NULL); 
00625        if (INVALID_HANDLE_VALUE == GC_stdout) ABORT("Open of log file failed");
00626     }
00627     if (GC_stderr == 0) {
00628        GC_stderr = GC_stdout;
00629     }
00630   }
00631 
00632 #endif
00633 
00634 #if defined(OS2) || defined(MACOS) || defined(linux)
00635 FILE * GC_stdout = NULL;
00636 FILE * GC_stderr = NULL;
00637 int GC_tmp;  /* Should really be local ... */
00638 
00639   void GC_set_files()
00640   {
00641       if (GC_stdout == NULL) {
00642        GC_stdout = stdout;
00643     }
00644     if (GC_stderr == NULL) {
00645        GC_stderr = stderr;
00646     }
00647   }
00648 #endif
00649 
00650 #if !defined(OS2) && !defined(MACOS) && !defined(MSWIN32) && !defined(linux)
00651   int GC_stdout = 1;
00652   int GC_stderr = 2;
00653 # if !defined(AMIGA)
00654 #   include <unistd.h>
00655 # endif
00656 #endif
00657 
00658 #if !defined(MSWIN32)  && !defined(OS2) && !defined(MACOS)
00659 int GC_write(fd, buf, len)
00660 int fd;
00661 char *buf;
00662 size_t len;
00663 {
00664      register int bytes_written = 0;
00665      register int result;
00666      
00667      while (bytes_written < len) {
00668 #      ifdef SOLARIS_THREADS
00669            result = syscall(SYS_write, fd, buf + bytes_written,
00670                                        len - bytes_written);
00671 #      else
00672            result = write(fd, buf + bytes_written, len - bytes_written);
00673 #      endif
00674        if (-1 == result) return(result);
00675        bytes_written += result;
00676     }
00677     return(bytes_written);
00678 }
00679 #endif /* UN*X */
00680 
00681 #ifdef MSWIN32
00682 #   define WRITE(f, buf, len) (GC_set_files(), \
00683                             GC_tmp = WriteFile((f), (buf), \
00684                                                    (len), &GC_junk, NULL),\
00685                             (GC_tmp? 1 : -1))
00686 #else
00687 #   if defined(OS2) || defined(MACOS) || defined(linux)
00688 #   define WRITE(f, buf, len) (GC_set_files(), \
00689                             GC_tmp = fwrite((buf), 1, (len), (f)), \
00690                             fflush(f), GC_tmp)
00691 #   else
00692 #     define WRITE(f, buf, len) GC_write((f), (buf), (len))
00693 #   endif
00694 #endif
00695 
00696 /* A version of printf that is unlikely to call malloc, and is thus safer */
00697 /* to call from the collector in case malloc has been bound to GC_malloc. */
00698 /* Assumes that no more than 1023 characters are written at once.       */
00699 /* Assumes that all arguments have been converted to something of the   */
00700 /* same size as long, and that the format conversions expect something         */
00701 /* of that size.                                                 */
00702 void GC_printf(format, a, b, c, d, e, f)
00703 char * format;
00704 long a, b, c, d, e, f;
00705 {
00706     char buf[1025];
00707     
00708     if (GC_quiet) return;
00709     buf[1024] = 0x15;
00710     (void) sprintf(buf, format, a, b, c, d, e, f);
00711     if (buf[1024] != 0x15) ABORT("GC_printf clobbered stack");
00712     if (WRITE(GC_stdout, buf, strlen(buf)) < 0) ABORT("write to stdout failed");
00713 }
00714 
00715 void GC_err_printf(format, a, b, c, d, e, f)
00716 char * format;
00717 long a, b, c, d, e, f;
00718 {
00719     char buf[1025];
00720     
00721     buf[1024] = 0x15;
00722     (void) sprintf(buf, format, a, b, c, d, e, f);
00723     if (buf[1024] != 0x15) ABORT("GC_err_printf clobbered stack");
00724     if (WRITE(GC_stderr, buf, strlen(buf)) < 0) ABORT("write to stderr failed");
00725 }
00726 
00727 void GC_err_puts(s)
00728 char *s;
00729 {
00730     if (WRITE(GC_stderr, s, strlen(s)) < 0) ABORT("write to stderr failed");
00731 }
00732 
00733 # if defined(__STDC__) || defined(__cplusplus)
00734     void GC_default_warn_proc(char *msg, GC_word arg)
00735 # else
00736     void GC_default_warn_proc(msg, arg)
00737     char *msg;
00738     GC_word arg;
00739 # endif
00740 {
00741     GC_err_printf1(msg, (unsigned long)arg);
00742 }
00743 
00744 GC_warn_proc GC_current_warn_proc = GC_default_warn_proc;
00745 
00746 # if defined(__STDC__) || defined(__cplusplus)
00747     GC_warn_proc GC_set_warn_proc(GC_warn_proc p)
00748 # else
00749     GC_warn_proc GC_set_warn_proc(p)
00750     GC_warn_proc p;
00751 # endif
00752 {
00753     GC_warn_proc result;
00754 
00755     LOCK();
00756     result = GC_current_warn_proc;
00757     GC_current_warn_proc = p;
00758     UNLOCK();
00759     return(result);
00760 }
00761 
00762 
00763 #ifndef PCR
00764 void GC_abort(msg)
00765 char * msg;
00766 {
00767     GC_err_printf1("%s\n", msg);
00768 #ifdef MACOS
00769        debugstr(msg);
00770        ExitToShell();
00771 #else    
00772     (void) abort();
00773 #endif
00774 }
00775 #endif
00776 
00777 #ifdef NEED_CALLINFO
00778 
00779 #if defined(MACOS) && defined(POWERPC)
00780 
00781 struct traceback_table {
00782        long zero;
00783        long magic;
00784        long reserved;
00785        long codeSize;
00786        short nameLength;
00787        char name[2];
00788 };
00789 typedef struct traceback_table traceback_table;
00790 
00791 static char* pc2name(word pc, char name[], long size)
00792 {
00793        name[0] = '\0';
00794        
00795        // make sure pc is instruction aligned (at least).
00796        if (pc == (pc & 0xFFFFFFFC)) {
00797               long instructionsToLook = 4096;
00798               long* instruction = (long*)pc;
00799               
00800               // look for the traceback table.
00801               while (instructionsToLook--) {
00802                      if (instruction[0] == 0x4E800020 && instruction[1] == 0x00000000) {
00803                             traceback_table* tb = (traceback_table*)&instruction[1];
00804                             long nameLength = (tb->nameLength > --size ? size : tb->nameLength);
00805                             memcpy(name, tb->name + 1, --nameLength);
00806                             name[nameLength] = '\0';
00807                             break;
00808                      }
00809                      ++instruction;
00810               }
00811        }
00812        
00813        return name;
00814 }
00815 
00816 extern void MWUnmangle(const char *mangled_name, char *unmangled_name, size_t buffersize);
00817 extern int GC_address_to_source(char* codeAddr, char symbolName[256], char fileName[256], UInt32* fileOffset);
00818 
00819 #if NFRAMES > 2
00820 
00821 void GC_print_callers(struct callinfo info[NFRAMES])
00822 {
00823     register int i;
00824     UInt32 file_offset;
00825     static char symbol_name[1024], unmangled_name[1024], file_name[256];
00826     
00827     GC_err_printf0("Callers at location:\n");
00828     for (i = 0; i < NFRAMES; i++) {
00829        if (info[i].ci_pc == 0) break;
00830        if (GC_address_to_source((char*)info[i].ci_pc, symbol_name, file_name, &file_offset)) {
00831               MWUnmangle(symbol_name, unmangled_name, sizeof(unmangled_name));
00832               GC_err_printf3("%s[%s,%ld]\n", unmangled_name, file_name, file_offset);
00833        } else {
00834               pc2name(info[i].ci_pc, symbol_name, sizeof(symbol_name));
00835               MWUnmangle(symbol_name, unmangled_name, sizeof(unmangled_name));
00836               GC_err_printf2("%s(%08X)\n", unmangled_name, info[i].ci_pc);
00837        }
00838     }
00839 }
00840 
00841 #else
00842 
00843 #include "call_tree.h"
00844 
00845 static char symbol_name[1024], unmangled_name[1024], file_name[256];
00846 
00847 void GC_print_call_tree(call_tree* tree)
00848 {
00849     UInt32 file_offset;
00850     if (GC_address_to_source((char*)tree->pc, symbol_name, file_name, &file_offset)) {
00851         MWUnmangle(symbol_name, unmangled_name, sizeof(unmangled_name));
00852         GC_err_printf3("%s[%s,%ld]", unmangled_name, file_name, file_offset);
00853     } else {
00854         pc2name((word)tree->pc, symbol_name, sizeof(symbol_name));
00855         MWUnmangle(symbol_name, unmangled_name, sizeof(unmangled_name));
00856         GC_err_printf2("%s(%08X)", unmangled_name, tree->pc);
00857     }
00858 }
00859 
00860 void GC_print_callers(struct callinfo info[NFRAMES])
00861 {
00862     UInt32 file_offset;
00863     call_tree* current_tree = (call_tree*)info[0].ci_pc;
00864     
00865     GC_err_printf0("Callers at location:\n");
00866     while (current_tree && current_tree->pc) {
00867        if (GC_address_to_source((char*)current_tree->pc, symbol_name, file_name, &file_offset)) {
00868               MWUnmangle(symbol_name, unmangled_name, sizeof(unmangled_name));
00869               GC_err_printf3("%s[%s,%ld]\n", unmangled_name, file_name, file_offset);
00870        } else {
00871               pc2name((word)current_tree->pc, symbol_name, sizeof(symbol_name));
00872               MWUnmangle(symbol_name, unmangled_name, sizeof(unmangled_name));
00873               GC_err_printf2("%s(%08X)\n", unmangled_name, current_tree->pc);
00874        }
00875        current_tree = current_tree->parent;
00876     }
00877 }
00878 
00879 #endif /* NFRAMES > 2 */
00880 
00881 #elif defined(LINUX)
00882 
00883 #define __USE_GNU
00884 #include <dlfcn.h>
00885 #include "call_tree.h"
00886 
00887 void GC_print_call_tree(call_tree* tree)
00888 {
00889     Dl_info dlinfo;
00890     if (dladdr(tree->pc, &dlinfo) >= 0) {
00891        unsigned offset = (tree->pc - dlinfo.dli_fbase);
00892        GC_err_printf3("%s[%s +0x%08X]", dlinfo.dli_sname, dlinfo.dli_fname, offset);
00893     } else {
00894        GC_err_printf2("%s(0x%08X)", "(unknown)", tree->pc);
00895     }
00896 }
00897 
00898 void GC_print_callers(struct callinfo info[NFRAMES])
00899 {
00900   register int i;
00901   call_tree* current_tree;
00902   Dl_info dlinfo;
00903   /* static char symbol_name[1024], unmangled_name[1024], file_name[256]; */
00904     
00905   current_tree = (call_tree*)(info[0].ci_pc);
00906     
00907   GC_err_printf0("Callers at location:\n");
00908   while (current_tree && current_tree->pc) {
00909     if (dladdr(current_tree->pc, &dlinfo) >= 0) {
00910       int offset = (int)current_tree->pc - (int)dlinfo.dli_fbase;
00911       GC_err_printf3("%s[%s +0x%08X]\n", dlinfo.dli_sname, dlinfo.dli_fname, offset);
00912     } else {
00913       GC_err_printf2("%s(%08X)\n", "(unknown)", current_tree->pc);
00914     }
00915     current_tree = current_tree->parent;
00916   }
00917 }
00918 
00919 #else
00920 
00921 void GC_print_callers (info)
00922 struct callinfo info[NFRAMES];
00923 {
00924     register int i;
00925     
00926 #   if NFRAMES == 1
00927       GC_err_printf0("\tCaller at allocation:\n");
00928 #   else
00929       GC_err_printf0("\tCall chain at allocation:\n");
00930 #   endif
00931     for (i = 0; i < NFRAMES; i++) {
00932        if (info[i].ci_pc == 0) break;
00933 #      if NARGS > 0
00934        {
00935          int j;
00936 
00937          GC_err_printf0("\t\targs: ");
00938          for (j = 0; j < NARGS; j++) {
00939            if (j != 0) GC_err_printf0(", ");
00940            GC_err_printf2("%d (0x%X)", ~(info[i].ci_arg[j]),
00941                                    ~(info[i].ci_arg[j]));
00942          }
00943          GC_err_printf0("\n");
00944        }
00945 #      endif
00946        GC_err_printf1("\t\t##PC##= 0x%X\n", info[i].ci_pc);
00947     }
00948 }
00949 
00950 #endif /* !MACOS */
00951 
00952 #endif /* SAVE_CALL_CHAIN */
00953 
00954 # ifdef SRC_M3
00955 void GC_enable()
00956 {
00957     GC_dont_gc--;
00958 }
00959 
00960 void GC_disable()
00961 {
00962     GC_dont_gc++;
00963 }
00964 # endif
00965 
00966 #if !defined(NO_DEBUGGING)
00967 
00968 void GC_dump()
00969 {
00970     GC_printf0("***Static roots:\n");
00971     GC_print_static_roots();
00972     GC_printf0("\n***Heap sections:\n");
00973     GC_print_heap_sects();
00974     GC_printf0("\n***Free blocks:\n");
00975     GC_print_hblkfreelist();
00976     GC_printf0("\n***Blocks in use:\n");
00977     GC_print_block_list();
00978 }
00979 
00980 # endif /* NO_DEBUGGING */