Back to index

plt-scheme  4.2.1
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  * Copyright (c) 1999-2001 by Hewlett-Packard Company. All rights reserved.
00005  *
00006  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
00007  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
00008  *
00009  * Permission is hereby granted to use or copy this program
00010  * for any purpose,  provided the above notices are retained on all copies.
00011  * Permission to modify the code and to distribute modified code is granted,
00012  * provided the above notices are retained, and a notice that the code was
00013  * modified is included with the above copyright notice.
00014  */
00015 /* Boehm, July 31, 1995 5:02 pm PDT */
00016 
00017 
00018 #include <stdio.h>
00019 #include <limits.h>
00020 #ifndef _WIN32_WCE
00021 #include <signal.h>
00022 #endif
00023 
00024 #define I_HIDE_POINTERS     /* To make GC_call_with_alloc_lock visible */
00025 #include "private/gc_pmark.h"
00026 
00027 #ifdef GC_SOLARIS_THREADS
00028 # include <sys/syscall.h>
00029 #endif
00030 #if defined(MSWIN32) || defined(MSWINCE)
00031 # define WIN32_LEAN_AND_MEAN
00032 # define NOSERVICE
00033 # include <windows.h>
00034 # include <tchar.h>
00035 #endif
00036 
00037 #ifdef NONSTOP
00038 # include <floss.h>
00039 #endif
00040 
00041 # ifdef THREADS
00042 #   ifdef PCR
00043 #     include "il/PCR_IL.h"
00044       PCR_Th_ML GC_allocate_ml;
00045 #   else
00046 #     ifdef SRC_M3
00047        /* Critical section counter is defined in the M3 runtime       */
00048        /* That's all we use.                                          */
00049 #     else
00050 #      ifdef GC_SOLARIS_THREADS
00051          mutex_t GC_allocate_ml;   /* Implicitly initialized.  */
00052 #      else
00053 #          if defined(GC_WIN32_THREADS) 
00054 #             if defined(GC_PTHREADS)
00055                 pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER;
00056 #            elif defined(GC_DLL)
00057                __declspec(dllexport) CRITICAL_SECTION GC_allocate_ml;
00058 #            else
00059                CRITICAL_SECTION GC_allocate_ml;
00060 #            endif
00061 #          else
00062 #             if defined(GC_PTHREADS) && !defined(GC_SOLARIS_THREADS)
00063 #             if defined(USE_SPIN_LOCK)
00064                  pthread_t GC_lock_holder = NO_THREAD;
00065 #              else
00066                 pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER;
00067                  pthread_t GC_lock_holder = NO_THREAD;
00068                      /* Used only for assertions, and to prevent       */
00069                      /* recursive reentry in the system call wrapper. */
00070 #             endif 
00071 #            else
00072                  --> declare allocator lock here
00073 #            endif
00074 #         endif
00075 #      endif
00076 #     endif
00077 #   endif
00078 # endif
00079 
00080 #if defined(NOSYS) || defined(ECOS)
00081 #undef STACKBASE
00082 #endif
00083 
00084 /* Dont unnecessarily call GC_register_main_static_data() in case     */
00085 /* dyn_load.c isn't linked in.                                        */
00086 #ifdef DYNAMIC_LOADING
00087 # define GC_REGISTER_MAIN_STATIC_DATA() GC_register_main_static_data()
00088 #else
00089 # define GC_REGISTER_MAIN_STATIC_DATA() TRUE
00090 #endif
00091 
00092 GC_FAR struct _GC_arrays GC_arrays /* = { 0 } */;
00093 
00094 
00095 GC_bool GC_debugging_started = FALSE;
00096        /* defined here so we don't have to load debug_malloc.o */
00097 
00098 void (*GC_check_heap) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0;
00099 void (*GC_print_all_smashed) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0;
00100 
00101 void (*GC_start_call_back) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0;
00102 
00103 ptr_t GC_stackbottom = 0;
00104 
00105 #ifdef IA64
00106   ptr_t GC_register_stackbottom = 0;
00107 #endif
00108 
00109 GC_bool GC_dont_gc = 0;
00110 
00111 GC_bool GC_dont_precollect = 0;
00112 
00113 GC_bool GC_quiet = 0;
00114 
00115 GC_bool GC_print_stats = 0;
00116 
00117 GC_bool GC_print_back_height = 0;
00118 
00119 #ifndef NO_DEBUGGING
00120   GC_bool GC_dump_regularly = 0;  /* Generate regular debugging dumps. */
00121 #endif
00122 
00123 #ifdef KEEP_BACK_PTRS
00124   long GC_backtraces = 0;   /* Number of random backtraces to  */
00125                             /* generate for each GC.           */
00126 #endif
00127 
00128 #ifdef FIND_LEAK
00129   int GC_find_leak = 1;
00130 #else
00131   int GC_find_leak = 0;
00132 #endif
00133 
00134 #ifdef ALL_INTERIOR_POINTERS
00135   int GC_all_interior_pointers = 1;
00136 #else
00137   int GC_all_interior_pointers = 0;
00138 #endif
00139 
00140 long GC_large_alloc_warn_interval = 5;
00141        /* Interval between unsuppressed warnings.       */
00142 
00143 long GC_large_alloc_warn_suppressed = 0;
00144        /* Number of warnings suppressed so far.  */
00145 
00146 /*ARGSUSED*/
00147 GC_PTR GC_default_oom_fn GC_PROTO((size_t bytes_requested))
00148 {
00149     return(0);
00150 }
00151 
00152 GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested)) = GC_default_oom_fn;
00153 
00154 extern signed_word GC_mem_found;
00155 
00156 void * GC_project2(arg1, arg2)
00157 void *arg1;
00158 void *arg2;
00159 {
00160   return arg2;
00161 }
00162 
00163 # ifdef MERGE_SIZES
00164     /* Set things up so that GC_size_map[i] >= words(i),              */
00165     /* but not too much bigger                                        */
00166     /* and so that size_map contains relatively few distinct entries  */
00167     /* This is stolen from Russ Atkinson's Cedar quantization         */
00168     /* alogrithm (but we precompute it).                       */
00169 
00170 
00171     void GC_init_size_map()
00172     {
00173        register unsigned i;
00174 
00175        /* Map size 0 to something bigger.               */
00176        /* This avoids problems at lower levels.         */
00177        /* One word objects don't have to be 2 word aligned,    */
00178        /* unless we're using mark bytes.                */
00179          for (i = 0; i < sizeof(word); i++) {
00180              GC_size_map[i] = MIN_WORDS;
00181          }
00182 #        if MIN_WORDS > 1
00183            GC_size_map[sizeof(word)] = MIN_WORDS;
00184 #        else
00185            GC_size_map[sizeof(word)] = ROUNDED_UP_WORDS(sizeof(word));
00186 #        endif
00187        for (i = sizeof(word) + 1; i <= 8 * sizeof(word); i++) {
00188            GC_size_map[i] = ALIGNED_WORDS(i);
00189        }
00190        for (i = 8*sizeof(word) + 1; i <= 16 * sizeof(word); i++) {
00191              GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
00192        }
00193 #      ifdef GC_GCJ_SUPPORT
00194           /* Make all sizes up to 32 words predictable, so that a     */
00195           /* compiler can statically perform the same computation,    */
00196           /* or at least a computation that results in similar size   */
00197           /* classes.                                                 */
00198           for (i = 16*sizeof(word) + 1; i <= 32 * sizeof(word); i++) {
00199              GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 3) & (~3);
00200           }
00201 #      endif
00202        /* We leave the rest of the array to be filled in on demand. */
00203     }
00204     
00205     /* Fill in additional entries in GC_size_map, including the ith one */
00206     /* We assume the ith entry is currently 0.                        */
00207     /* Note that a filled in section of the array ending at n always    */
00208     /* has length at least n/4.                                       */
00209     void GC_extend_size_map(i)
00210     word i;
00211     {
00212         word orig_word_sz = ROUNDED_UP_WORDS(i);
00213         word word_sz = orig_word_sz;
00214        register word byte_sz = WORDS_TO_BYTES(word_sz);
00215                             /* The size we try to preserve.           */
00216                             /* Close to to i, unless this would       */
00217                             /* introduce too many distinct sizes.     */
00218        word smaller_than_i = byte_sz - (byte_sz >> 3);
00219        word much_smaller_than_i = byte_sz - (byte_sz >> 2);
00220        register word low_limit;    /* The lowest indexed entry we     */
00221                                    /* initialize.                     */
00222        register word j;
00223        
00224        if (GC_size_map[smaller_than_i] == 0) {
00225            low_limit = much_smaller_than_i;
00226            while (GC_size_map[low_limit] != 0) low_limit++;
00227        } else {
00228            low_limit = smaller_than_i + 1;
00229            while (GC_size_map[low_limit] != 0) low_limit++;
00230            word_sz = ROUNDED_UP_WORDS(low_limit);
00231            word_sz += word_sz >> 3;
00232            if (word_sz < orig_word_sz) word_sz = orig_word_sz;
00233        }
00234 #      ifdef ALIGN_DOUBLE
00235            word_sz += 1;
00236            word_sz &= ~1;
00237 #      endif
00238        if (word_sz > MAXOBJSZ) {
00239            word_sz = MAXOBJSZ;
00240        }
00241        /* If we can fit the same number of larger objects in a block, */
00242        /* do so.                                               */ 
00243        {
00244            size_t number_of_objs = BODY_SZ/word_sz;
00245            word_sz = BODY_SZ/number_of_objs;
00246 #          ifdef ALIGN_DOUBLE
00247               word_sz &= ~1;
00248 #          endif
00249        }
00250        byte_sz = WORDS_TO_BYTES(word_sz);
00251        if (GC_all_interior_pointers) {
00252            /* We need one extra byte; don't fill in GC_size_map[byte_sz] */
00253            byte_sz -= EXTRA_BYTES;
00254        }
00255 
00256        for (j = low_limit; j <= byte_sz; j++) GC_size_map[j] = word_sz;  
00257     }
00258 # endif
00259 
00260 
00261 /*
00262  * The following is a gross hack to deal with a problem that can occur
00263  * on machines that are sloppy about stack frame sizes, notably SPARC.
00264  * Bogus pointers may be written to the stack and not cleared for
00265  * a LONG time, because they always fall into holes in stack frames
00266  * that are not written.  We partially address this by clearing
00267  * sections of the stack whenever we get control.
00268  */
00269 word GC_stack_last_cleared = 0;    /* GC_no when we last did this */
00270 # ifdef THREADS
00271 #   define BIG_CLEAR_SIZE 2048     /* Clear this much now and then.   */
00272 #   define SMALL_CLEAR_SIZE 256 /* Clear this much every time.        */
00273 # endif
00274 # define CLEAR_SIZE 213  /* Granularity for GC_clear_stack_inner */
00275 # define DEGRADE_RATE 50
00276 
00277 word GC_min_sp;             /* Coolest stack pointer value from which we've */
00278                      /* already cleared the stack.                    */
00279                      
00280 word GC_high_water;
00281                      /* "hottest" stack pointer value we have seen    */
00282                      /* recently.  Degrades over time.         */
00283 
00284 word GC_words_allocd_at_reset;
00285 
00286 #if defined(ASM_CLEAR_CODE)
00287   extern ptr_t GC_clear_stack_inner();
00288 #else  
00289 /* Clear the stack up to about limit.  Return arg. */
00290 /*ARGSUSED*/
00291 ptr_t GC_clear_stack_inner(arg, limit)
00292 ptr_t arg;
00293 word limit;
00294 {
00295     word dummy[CLEAR_SIZE];
00296     
00297     BZERO(dummy, CLEAR_SIZE*sizeof(word));
00298     if ((word)(dummy) COOLER_THAN limit) {
00299         (void) GC_clear_stack_inner(arg, limit);
00300     }
00301     /* Make sure the recursive call is not a tail call, and the bzero */
00302     /* call is not recognized as dead code.                           */
00303     GC_noop1((word)dummy);
00304     return(arg);
00305 }
00306 #endif
00307 
00308 /* Clear some of the inaccessible part of the stack.  Returns its     */
00309 /* argument, so it can be used in a tail call position, hence clearing  */
00310 /* another frame.                                              */
00311 ptr_t GC_clear_stack(arg)
00312 ptr_t arg;
00313 {
00314     register word sp = (word)GC_approx_sp();  /* Hotter than actual sp */
00315 #   ifdef THREADS
00316         word dummy[SMALL_CLEAR_SIZE];
00317        static unsigned random_no = 0;
00318                                     /* Should be more random than it is ... */
00319                              /* Used to occasionally clear a bigger    */
00320                              /* chunk.                          */
00321 #   endif
00322     register word limit;
00323     
00324 #   define SLOP 400
00325        /* Extra bytes we clear every time.  This clears our own       */
00326        /* activation record, and should cause more frequent           */
00327        /* clearing near the cold end of the stack, a good thing.      */
00328 #   define GC_SLOP 4000
00329        /* We make GC_high_water this much hotter than we really saw          */
00330        /* saw it, to cover for GC noise etc. above our current frame. */
00331 #   define CLEAR_THRESHOLD 100000
00332        /* We restart the clearing process after this many bytes of    */
00333        /* allocation.  Otherwise very heavily recursive programs      */
00334        /* with sparse stacks may result in heaps that grow almost     */
00335        /* without bounds.  As the heap gets larger, collection        */
00336        /* frequency decreases, thus clearing frequency would decrease, */
00337        /* thus more junk remains accessible, thus the heap gets       */
00338        /* larger ...                                           */
00339 # ifdef THREADS
00340     if (++random_no % 13 == 0) {
00341        limit = sp;
00342        MAKE_HOTTER(limit, BIG_CLEAR_SIZE*sizeof(word));
00343         limit &= ~0xf;      /* Make it sufficiently aligned for assembly     */
00344                      /* implementations of GC_clear_stack_inner.      */
00345        return GC_clear_stack_inner(arg, limit);
00346     } else {
00347        BZERO(dummy, SMALL_CLEAR_SIZE*sizeof(word));
00348        return arg;
00349     }
00350 # else
00351     if (GC_gc_no > GC_stack_last_cleared) {
00352         /* Start things over, so we clear the entire stack again */
00353         if (GC_stack_last_cleared == 0) GC_high_water = (word) GC_stackbottom;
00354         GC_min_sp = GC_high_water;
00355         GC_stack_last_cleared = GC_gc_no;
00356         GC_words_allocd_at_reset = GC_words_allocd;
00357     }
00358     /* Adjust GC_high_water */
00359         MAKE_COOLER(GC_high_water, WORDS_TO_BYTES(DEGRADE_RATE) + GC_SLOP);
00360         if (sp HOTTER_THAN GC_high_water) {
00361             GC_high_water = sp;
00362         }
00363         MAKE_HOTTER(GC_high_water, GC_SLOP);
00364     limit = GC_min_sp;
00365     MAKE_HOTTER(limit, SLOP);
00366     if (sp COOLER_THAN limit) {
00367         limit &= ~0xf;      /* Make it sufficiently aligned for assembly     */
00368                      /* implementations of GC_clear_stack_inner.      */
00369         GC_min_sp = sp;
00370         return(GC_clear_stack_inner(arg, limit));
00371     } else if (WORDS_TO_BYTES(GC_words_allocd - GC_words_allocd_at_reset)
00372               > CLEAR_THRESHOLD) {
00373        /* Restart clearing process, but limit how much clearing we do. */
00374        GC_min_sp = sp;
00375        MAKE_HOTTER(GC_min_sp, CLEAR_THRESHOLD/4);
00376        if (GC_min_sp HOTTER_THAN GC_high_water) GC_min_sp = GC_high_water;
00377        GC_words_allocd_at_reset = GC_words_allocd;
00378     }  
00379     return(arg);
00380 # endif
00381 }
00382 
00383 
00384 /* Return a pointer to the base address of p, given a pointer to a    */
00385 /* an address within an object.  Return 0 o.w.                        */
00386 # ifdef __STDC__
00387     GC_PTR GC_base(GC_PTR p)
00388 # else
00389     GC_PTR GC_base(p)
00390     GC_PTR p;
00391 # endif
00392 {
00393     register word r;
00394     register struct hblk *h;
00395     register bottom_index *bi;
00396     register hdr *candidate_hdr;
00397     register word limit;
00398     
00399     r = (word)p;
00400     if (!GC_is_initialized) return 0;
00401     h = HBLKPTR(r);
00402     GET_BI(r, bi);
00403     candidate_hdr = HDR_FROM_BI(bi, r);
00404     if (candidate_hdr == 0) return(0);
00405     /* If it's a pointer to the middle of a large object, move it     */
00406     /* to the beginning.                                       */
00407        while (IS_FORWARDING_ADDR_OR_NIL(candidate_hdr)) {
00408           h = FORWARDED_ADDR(h,candidate_hdr);
00409           r = (word)h;
00410           candidate_hdr = HDR(h);
00411        }
00412     if (candidate_hdr -> hb_map == GC_invalid_map) return(0);
00413     /* Make sure r points to the beginning of the object */
00414        r &= ~(WORDS_TO_BYTES(1) - 1);
00415         {
00416            register int offset = HBLKDISPL(r);
00417            register signed_word sz = candidate_hdr -> hb_sz;
00418            register signed_word map_entry;
00419              
00420            map_entry = MAP_ENTRY((candidate_hdr -> hb_map), offset);
00421            if (map_entry > CPP_MAX_OFFSET) {
00422               map_entry = (signed_word)(BYTES_TO_WORDS(offset)) % sz;
00423             }
00424             r -= WORDS_TO_BYTES(map_entry);
00425             limit = r + WORDS_TO_BYTES(sz);
00426            if (limit > (word)(h + 1)
00427                && sz <= BYTES_TO_WORDS(HBLKSIZE)) {
00428                return(0);
00429            }
00430            if ((word)p >= limit) return(0);
00431        }
00432     return((GC_PTR)r);
00433 }
00434 
00435 
00436 /* Return the size of an object, given a pointer to its base.         */
00437 /* (For small obects this also happens to work from interior pointers,       */
00438 /* but that shouldn't be relied upon.)                                */
00439 # ifdef __STDC__
00440     size_t GC_size(GC_PTR p)
00441 # else
00442     size_t GC_size(p)
00443     GC_PTR p;
00444 # endif
00445 {
00446     register int sz;
00447     register hdr * hhdr = HDR(p);
00448     
00449     sz = WORDS_TO_BYTES(hhdr -> hb_sz);
00450     return(sz);
00451 }
00452 
00453 size_t GC_get_heap_size GC_PROTO(())
00454 {
00455     return ((size_t) GC_heapsize);
00456 }
00457 
00458 size_t GC_get_free_bytes GC_PROTO(())
00459 {
00460     return ((size_t) GC_large_free_bytes);
00461 }
00462 
00463 size_t GC_get_bytes_since_gc GC_PROTO(())
00464 {
00465     return ((size_t) WORDS_TO_BYTES(GC_words_allocd));
00466 }
00467 
00468 size_t GC_get_total_bytes GC_PROTO(())
00469 {
00470     return ((size_t) WORDS_TO_BYTES(GC_words_allocd+GC_words_allocd_before_gc));
00471 }
00472 
00473 GC_bool GC_is_initialized = FALSE;
00474 
00475 void GC_init()
00476 {
00477     DCL_LOCK_STATE;
00478     
00479     DISABLE_SIGNALS();
00480 
00481 #if defined(GC_WIN32_THREADS) && !defined(GC_PTHREADS)
00482     if (!GC_is_initialized) {
00483       BOOL (WINAPI *pfn) (LPCRITICAL_SECTION, DWORD) = NULL;
00484       HMODULE hK32 = GetModuleHandleA("kernel32.dll");
00485       if (hK32)
00486          pfn = (BOOL (WINAPI *) (LPCRITICAL_SECTION, DWORD))
00487               GetProcAddress (hK32,
00488                             "InitializeCriticalSectionAndSpinCount");
00489       if (pfn)
00490           pfn(&GC_allocate_ml, 4000);
00491       else
00492          InitializeCriticalSection (&GC_allocate_ml);
00493     }
00494 #endif /* MSWIN32 */
00495 
00496     LOCK();
00497     GC_init_inner();
00498     UNLOCK();
00499     ENABLE_SIGNALS();
00500 
00501 #   if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
00502        /* Make sure marker threads and started and thread local */
00503        /* allocation is initialized, in case we didn't get      */
00504        /* called from GC_init_parallel();                */
00505         {
00506          extern void GC_init_parallel(void);
00507          GC_init_parallel();
00508        }
00509 #   endif /* PARALLEL_MARK || THREAD_LOCAL_ALLOC */
00510 
00511 #   if defined(DYNAMIC_LOADING) && defined(DARWIN)
00512     {
00513         /* This must be called WITHOUT the allocation lock held
00514         and before any threads are created */
00515         extern void GC_init_dyld();
00516         GC_init_dyld();
00517     }
00518 #   endif
00519 }
00520 
00521 #if defined(MSWIN32) || defined(MSWINCE)
00522     CRITICAL_SECTION GC_write_cs;
00523 #endif
00524 
00525 #ifdef MSWIN32
00526     extern void GC_init_win32 GC_PROTO((void));
00527 #endif
00528 
00529 extern void GC_setpagesize();
00530 
00531 
00532 #ifdef MSWIN32
00533 extern GC_bool GC_no_win32_dlls;
00534 #else
00535 # define GC_no_win32_dlls FALSE
00536 #endif
00537 
00538 void GC_exit_check GC_PROTO((void))
00539 {
00540    GC_gcollect();
00541 }
00542 
00543 #ifdef SEARCH_FOR_DATA_START
00544   extern void GC_init_linux_data_start GC_PROTO((void));
00545 #endif
00546 
00547 #ifdef UNIX_LIKE
00548 
00549 extern void GC_set_and_save_fault_handler GC_PROTO((void (*handler)(int)));
00550 
00551 static void looping_handler(sig)
00552 int sig;
00553 {
00554     GC_err_printf1("Caught signal %d: looping in handler\n", sig);
00555     for(;;);
00556 }
00557 
00558 static GC_bool installed_looping_handler = FALSE;
00559 
00560 static void maybe_install_looping_handler()
00561 {
00562     /* Install looping handler before the write fault handler, so we  */
00563     /* handle write faults correctly.                                 */
00564       if (!installed_looping_handler && 0 != GETENV("GC_LOOP_ON_ABORT")) {
00565         GC_set_and_save_fault_handler(looping_handler);
00566         installed_looping_handler = TRUE;
00567       }
00568 }
00569 
00570 #else /* !UNIX_LIKE */
00571 
00572 # define maybe_install_looping_handler()
00573 
00574 #endif
00575 
00576 void GC_init_inner()
00577 {
00578 #   if !defined(THREADS) && defined(GC_ASSERTIONS)
00579         word dummy;
00580 #   endif
00581     word initial_heap_sz = (word)MINHINCR;
00582     
00583     if (GC_is_initialized) return;
00584 #   ifdef PRINTSTATS
00585       GC_print_stats = 1;
00586 #   endif
00587 #   if defined(MSWIN32) || defined(MSWINCE)
00588       InitializeCriticalSection(&GC_write_cs);
00589 #   endif
00590     if (0 != GETENV("GC_PRINT_STATS")) {
00591       GC_print_stats = 1;
00592     } 
00593 #   ifndef NO_DEBUGGING
00594       if (0 != GETENV("GC_DUMP_REGULARLY")) {
00595         GC_dump_regularly = 1;
00596       }
00597 #   endif
00598 #   ifdef KEEP_BACK_PTRS
00599       {
00600         char * backtraces_string = GETENV("GC_BACKTRACES");
00601         if (0 != backtraces_string) {
00602           GC_backtraces = atol(backtraces_string);
00603          if (backtraces_string[0] == '\0') GC_backtraces = 1;
00604         }
00605       }
00606 #   endif
00607     if (0 != GETENV("GC_FIND_LEAK")) {
00608       GC_find_leak = 1;
00609 #     ifdef __STDC__
00610         atexit(GC_exit_check);
00611 #     endif
00612     }
00613     if (0 != GETENV("GC_ALL_INTERIOR_POINTERS")) {
00614       GC_all_interior_pointers = 1;
00615     }
00616     if (0 != GETENV("GC_DONT_GC")) {
00617       GC_dont_gc = 1;
00618     }
00619     if (0 != GETENV("GC_PRINT_BACK_HEIGHT")) {
00620       GC_print_back_height = 1;
00621     }
00622     if (0 != GETENV("GC_NO_BLACKLIST_WARNING")) {
00623       GC_large_alloc_warn_interval = LONG_MAX;
00624     }
00625     {
00626       char * time_limit_string = GETENV("GC_PAUSE_TIME_TARGET");
00627       if (0 != time_limit_string) {
00628         long time_limit = atol(time_limit_string);
00629         if (time_limit < 5) {
00630          WARN("GC_PAUSE_TIME_TARGET environment variable value too small "
00631               "or bad syntax: Ignoring\n", 0);
00632         } else {
00633          GC_time_limit = time_limit;
00634         }
00635       }
00636     }
00637     {
00638       char * interval_string = GETENV("GC_LARGE_ALLOC_WARN_INTERVAL");
00639       if (0 != interval_string) {
00640         long interval = atol(interval_string);
00641         if (interval <= 0) {
00642          WARN("GC_LARGE_ALLOC_WARN_INTERVAL environment variable has "
00643               "bad value: Ignoring\n", 0);
00644         } else {
00645          GC_large_alloc_warn_interval = interval;
00646         }
00647       }
00648     }
00649     maybe_install_looping_handler();
00650     /* Adjust normal object descriptor for extra allocation.   */
00651     if (ALIGNMENT > GC_DS_TAGS && EXTRA_BYTES != 0) {
00652       GC_obj_kinds[NORMAL].ok_descriptor = ((word)(-ALIGNMENT) | GC_DS_LENGTH);
00653     }
00654     GC_setpagesize();
00655     GC_exclude_static_roots(beginGC_arrays, endGC_arrays);
00656     GC_exclude_static_roots(beginGC_obj_kinds, endGC_obj_kinds);
00657 #   ifdef SEPARATE_GLOBALS
00658       GC_exclude_static_roots(beginGC_objfreelist, endGC_objfreelist);
00659       GC_exclude_static_roots(beginGC_aobjfreelist, endGC_aobjfreelist);
00660 #   endif
00661 #   ifdef MSWIN32
00662        GC_init_win32();
00663 #   endif
00664 #   if defined(SEARCH_FOR_DATA_START)
00665        GC_init_linux_data_start();
00666 #   endif
00667 #   if (defined(NETBSD) || defined(OPENBSD)) && defined(__ELF__)
00668        if (!GC_no_dls) /* PLTSCHEME: hack */
00669          GC_init_netbsd_elf();
00670 #   endif
00671 #   if defined(GC_PTHREADS) || defined(GC_SOLARIS_THREADS) \
00672        || defined(GC_WIN32_THREADS)
00673         GC_thr_init();
00674 #   endif
00675 #   ifdef GC_SOLARIS_THREADS
00676        /* We need dirty bits in order to find live stack sections.    */
00677         GC_dirty_init();
00678 #   endif
00679 #   if !defined(THREADS) || defined(GC_PTHREADS) || defined(GC_WIN32_THREADS) \
00680        || defined(GC_SOLARIS_THREADS)
00681       if (GC_stackbottom == 0) {
00682        GC_stackbottom = GC_get_stack_base();
00683 #       if (defined(LINUX) || defined(HPUX)) && defined(IA64)
00684          GC_register_stackbottom = GC_get_register_stack_base();
00685 #       endif
00686       } else {
00687 #       if (defined(LINUX) || defined(HPUX)) && defined(IA64)
00688          if (GC_register_stackbottom == 0) {
00689            WARN("GC_register_stackbottom should be set with GC_stackbottom", 0);
00690            /* The following may fail, since we may rely on            */
00691            /* alignment properties that may not hold with a user set  */
00692            /* GC_stackbottom.                                         */
00693            GC_register_stackbottom = GC_get_register_stack_base();
00694          }
00695 #      endif
00696       }
00697 #   endif
00698     GC_STATIC_ASSERT(sizeof (ptr_t) == sizeof(word));
00699     GC_STATIC_ASSERT(sizeof (signed_word) == sizeof(word));
00700     GC_STATIC_ASSERT(sizeof (struct hblk) == HBLKSIZE);
00701 #   ifndef THREADS
00702 #     if defined(STACK_GROWS_UP) && defined(STACK_GROWS_DOWN)
00703        ABORT(
00704          "Only one of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
00705 #     endif
00706 #     if !defined(STACK_GROWS_UP) && !defined(STACK_GROWS_DOWN)
00707        ABORT(
00708          "One of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
00709 #     endif
00710 #     ifdef STACK_GROWS_DOWN
00711         GC_ASSERT((word)(&dummy) <= (word)GC_stackbottom);
00712 #     else
00713         GC_ASSERT((word)(&dummy) >= (word)GC_stackbottom);
00714 #     endif
00715 #   endif
00716 #   if !defined(_AUX_SOURCE) || defined(__GNUC__)
00717       GC_ASSERT((word)(-1) > (word)0);
00718       /* word should be unsigned */
00719 #   endif
00720     GC_ASSERT((signed_word)(-1) < (signed_word)0);
00721     
00722     /* Add initial guess of root sets.  Do this first, since sbrk(0)  */
00723     /* might be used.                                                 */
00724     if (!GC_no_dls) /* PLTSCHEME: hack */
00725       if (GC_REGISTER_MAIN_STATIC_DATA()) GC_register_data_segments();
00726     GC_init_headers();
00727     GC_bl_init();
00728     GC_mark_init();
00729     {
00730        char * sz_str = GETENV("GC_INITIAL_HEAP_SIZE");
00731        if (sz_str != NULL) {
00732          initial_heap_sz = atoi(sz_str);
00733          if (initial_heap_sz <= MINHINCR * HBLKSIZE) {
00734            WARN("Bad initial heap size %s - ignoring it.\n",
00735                sz_str);
00736          } 
00737          initial_heap_sz = divHBLKSZ(initial_heap_sz);
00738        }
00739     }
00740     {
00741        char * sz_str = GETENV("GC_MAXIMUM_HEAP_SIZE");
00742        if (sz_str != NULL) {
00743          word max_heap_sz = (word)atol(sz_str);
00744          if (max_heap_sz < initial_heap_sz * HBLKSIZE) {
00745            WARN("Bad maximum heap size %s - ignoring it.\n",
00746                sz_str);
00747          } 
00748          if (0 == GC_max_retries) GC_max_retries = 2;
00749          GC_set_max_heap_size(max_heap_sz);
00750        }
00751     }
00752     if (!GC_expand_hp_inner(initial_heap_sz)) {
00753         GC_err_printf0("Can't start up: not enough memory\n");
00754         EXIT();
00755     }
00756     /* Preallocate large object map.  It's otherwise inconvenient to  */
00757     /* deal with failure.                                      */
00758       if (!GC_add_map_entry((word)0)) {
00759         GC_err_printf0("Can't start up: not enough memory\n");
00760         EXIT();
00761       }
00762     GC_register_displacement_inner(0L);
00763 #   ifdef MERGE_SIZES
00764       GC_init_size_map();
00765 #   endif
00766 #   ifdef PCR
00767       if (PCR_IL_Lock(PCR_Bool_false, PCR_allSigsBlocked, PCR_waitForever)
00768           != PCR_ERes_okay) {
00769           ABORT("Can't lock load state\n");
00770       } else if (PCR_IL_Unlock() != PCR_ERes_okay) {
00771           ABORT("Can't unlock load state\n");
00772       }
00773       PCR_IL_Unlock();
00774       GC_pcr_install();
00775 #   endif
00776 #   if !defined(SMALL_CONFIG)
00777       if (!GC_no_win32_dlls && 0 != GETENV("GC_ENABLE_INCREMENTAL")) {
00778        GC_ASSERT(!GC_incremental);
00779         GC_setpagesize();
00780 #       ifndef GC_SOLARIS_THREADS
00781           GC_dirty_init();
00782 #       endif
00783         GC_ASSERT(GC_words_allocd == 0)
00784        GC_incremental = TRUE;
00785       }
00786 #   endif /* !SMALL_CONFIG */
00787     COND_DUMP;
00788     /* Get black list set up and/or incremental GC started */
00789       if (!GC_dont_precollect || GC_incremental) GC_gcollect_inner();
00790     GC_is_initialized = TRUE;
00791 #   ifdef STUBBORN_ALLOC
00792        GC_stubborn_init();
00793 #   endif
00794     /* Convince lint that some things are used */
00795 #   ifdef LINT
00796       {
00797           extern char * GC_copyright[];
00798           extern int GC_read();
00799           extern void GC_register_finalizer_no_order();
00800           
00801           GC_noop(GC_copyright, GC_find_header,
00802                   GC_push_one, GC_call_with_alloc_lock, GC_read,
00803                   GC_dont_expand,
00804 #               ifndef NO_DEBUGGING
00805                   GC_dump,
00806 #               endif
00807                   GC_register_finalizer_no_order);
00808       }
00809 #   endif
00810 }
00811 
00812 void GC_enable_incremental GC_PROTO(())
00813 {
00814 # if !defined(SMALL_CONFIG) && !defined(KEEP_BACK_PTRS)
00815   /* If we are keeping back pointers, the GC itself dirties all       */
00816   /* pages on which objects have been marked, making           */
00817   /* incremental GC pointless.                                 */
00818   if (!GC_find_leak) {
00819     DCL_LOCK_STATE;
00820     
00821     DISABLE_SIGNALS();
00822     LOCK();
00823     if (GC_incremental) goto out;
00824     GC_setpagesize();
00825     if (GC_no_win32_dlls) goto out;
00826 #   ifndef GC_SOLARIS_THREADS 
00827       maybe_install_looping_handler();  /* Before write fault handler! */
00828       GC_dirty_init();
00829 #   endif
00830     if (!GC_is_initialized) {
00831         GC_init_inner();
00832     }
00833     if (GC_incremental) goto out;
00834     if (GC_dont_gc) {
00835         /* Can't easily do it. */
00836         UNLOCK();
00837        ENABLE_SIGNALS();
00838        return;
00839     }
00840     if (GC_words_allocd > 0) {
00841        /* There may be unmarked reachable objects       */
00842        GC_gcollect_inner();
00843     }   /* else we're OK in assuming everything's       */
00844        /* clean since nothing can point to an           */
00845        /* unmarked object.                       */
00846     GC_read_dirty();
00847     GC_incremental = TRUE;
00848 out:
00849     UNLOCK();
00850     ENABLE_SIGNALS();
00851   }
00852 # endif
00853 }
00854 
00855 
00856 #if defined(MSWIN32) || defined(MSWINCE)
00857 # define LOG_FILE _T("gc.log")
00858 
00859   HANDLE GC_stdout = 0;
00860 
00861   void GC_deinit()
00862   {
00863       if (GC_is_initialized) {
00864        DeleteCriticalSection(&GC_write_cs);
00865       }
00866   }
00867 
00868   int GC_write(buf, len)
00869   GC_CONST char * buf;
00870   size_t len;
00871   {
00872       BOOL tmp;
00873       DWORD written;
00874       if (len == 0)
00875          return 0;
00876       EnterCriticalSection(&GC_write_cs);
00877       if (GC_stdout == INVALID_HANDLE_VALUE) {
00878          return -1;
00879       } else if (GC_stdout == 0) {
00880          GC_stdout = CreateFile(LOG_FILE, GENERIC_WRITE,
00881                              FILE_SHARE_READ | FILE_SHARE_WRITE,
00882                              NULL, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH,
00883                              NULL); 
00884          if (GC_stdout == INVALID_HANDLE_VALUE) ABORT("Open of log file failed");
00885       }
00886       tmp = WriteFile(GC_stdout, buf, len, &written, NULL);
00887       if (!tmp)
00888          DebugBreak();
00889       LeaveCriticalSection(&GC_write_cs);
00890       return tmp ? (int)written : -1;
00891   }
00892 
00893 #endif
00894 
00895 #if defined(OS2) || defined(MACOS)
00896 FILE * GC_stdout = NULL;
00897 FILE * GC_stderr = NULL;
00898 int GC_tmp;  /* Should really be local ... */
00899 
00900   void GC_set_files()
00901   {
00902       if (GC_stdout == NULL) {
00903        GC_stdout = stdout;
00904     }
00905     if (GC_stderr == NULL) {
00906        GC_stderr = stderr;
00907     }
00908   }
00909 #endif
00910 
00911 #if !defined(OS2) && !defined(MACOS) && !defined(MSWIN32) && !defined(MSWINCE)
00912   int GC_stdout = 1;
00913   int GC_stderr = 2;
00914 # if !defined(AMIGA)
00915 #   include <unistd.h>
00916 # endif
00917 #endif
00918 
00919 #if !defined(MSWIN32) && !defined(MSWINCE) && !defined(OS2) \
00920     && !defined(MACOS)  && !defined(ECOS) && !defined(NOSYS)
00921 int GC_write(fd, buf, len)
00922 int fd;
00923 GC_CONST char *buf;
00924 size_t len;
00925 {
00926      register int bytes_written = 0;
00927      register int result;
00928      
00929      while (bytes_written < len) {
00930 #      ifdef GC_SOLARIS_THREADS
00931            result = syscall(SYS_write, fd, buf + bytes_written,
00932                                        len - bytes_written);
00933 #      else
00934            result = write(fd, buf + bytes_written, len - bytes_written);
00935 #      endif
00936        if (-1 == result) return(result);
00937        bytes_written += result;
00938     }
00939     return(bytes_written);
00940 }
00941 #endif /* UN*X */
00942 
00943 #ifdef ECOS
00944 int GC_write(fd, buf, len)
00945 {
00946   _Jv_diag_write (buf, len);
00947   return len;
00948 }
00949 #endif
00950 
00951 #ifdef NOSYS
00952 int GC_write(fd, buf, len)
00953 {
00954   /* No writing.  */
00955   return len;
00956 }
00957 #endif
00958 
00959 
00960 #if defined(MSWIN32) || defined(MSWINCE)
00961 #   define WRITE(f, buf, len) GC_write(buf, len)
00962 #else
00963 #   if defined(OS2) || defined(MACOS)
00964 #   define WRITE(f, buf, len) (GC_set_files(), \
00965                             GC_tmp = fwrite((buf), 1, (len), (f)), \
00966                             fflush(f), GC_tmp)
00967 #   else
00968 #     define WRITE(f, buf, len) GC_write((f), (buf), (len))
00969 #   endif
00970 #endif
00971 
00972 /* A version of printf that is unlikely to call malloc, and is thus safer */
00973 /* to call from the collector in case malloc has been bound to GC_malloc. */
00974 /* Assumes that no more than 1023 characters are written at once.       */
00975 /* Assumes that all arguments have been converted to something of the   */
00976 /* same size as long, and that the format conversions expect something         */
00977 /* of that size.                                                 */
00978 void GC_printf(format, a, b, c, d, e, f)
00979 GC_CONST char * format;
00980 long a, b, c, d, e, f;
00981 {
00982     char buf[1025];
00983     
00984     if (GC_quiet) return;
00985     buf[1024] = 0x15;
00986     (void) sprintf(buf, format, a, b, c, d, e, f);
00987     if (buf[1024] != 0x15) ABORT("GC_printf clobbered stack");
00988     if (WRITE(GC_stdout, buf, strlen(buf)) < 0) ABORT("write to stdout failed");
00989 }
00990 
00991 void GC_err_printf(format, a, b, c, d, e, f)
00992 GC_CONST char * format;
00993 long a, b, c, d, e, f;
00994 {
00995     char buf[1025];
00996     
00997     buf[1024] = 0x15;
00998     (void) sprintf(buf, format, a, b, c, d, e, f);
00999     if (buf[1024] != 0x15) ABORT("GC_err_printf clobbered stack");
01000     if (WRITE(GC_stderr, buf, strlen(buf)) < 0) ABORT("write to stderr failed");
01001 }
01002 
01003 void GC_err_puts(s)
01004 GC_CONST char *s;
01005 {
01006     if (WRITE(GC_stderr, s, strlen(s)) < 0) ABORT("write to stderr failed");
01007 }
01008 
01009 #if defined(LINUX) && !defined(SMALL_CONFIG)
01010 void GC_err_write(buf, len)
01011 GC_CONST char *buf;
01012 size_t len;
01013 {
01014     if (WRITE(GC_stderr, buf, len) < 0) ABORT("write to stderr failed");
01015 }
01016 #endif
01017 
01018 # if defined(__STDC__) || defined(__cplusplus)
01019     void GC_default_warn_proc(char *msg, GC_word arg)
01020 # else
01021     void GC_default_warn_proc(msg, arg)
01022     char *msg;
01023     GC_word arg;
01024 # endif
01025 {
01026     GC_err_printf1(msg, (unsigned long)arg);
01027 }
01028 
01029 GC_warn_proc GC_current_warn_proc = GC_default_warn_proc;
01030 
01031 # if defined(__STDC__) || defined(__cplusplus)
01032     GC_warn_proc GC_set_warn_proc(GC_warn_proc p)
01033 # else
01034     GC_warn_proc GC_set_warn_proc(p)
01035     GC_warn_proc p;
01036 # endif
01037 {
01038     GC_warn_proc result;
01039 
01040 #   ifdef GC_WIN32_THREADS
01041       GC_ASSERT(GC_is_initialized);
01042 #   endif
01043     LOCK();
01044     result = GC_current_warn_proc;
01045     GC_current_warn_proc = p;
01046     UNLOCK();
01047     return(result);
01048 }
01049 
01050 # if defined(__STDC__) || defined(__cplusplus)
01051     GC_word GC_set_free_space_divisor (GC_word value)
01052 # else
01053     GC_word GC_set_free_space_divisor (value)
01054     GC_word value;
01055 # endif
01056 {
01057     GC_word old = GC_free_space_divisor;
01058     GC_free_space_divisor = value;
01059     return old;
01060 }
01061 
01062 #ifndef PCR
01063 void GC_abort(msg)
01064 GC_CONST char * msg;
01065 {
01066 #   if defined(MSWIN32)
01067       (void) MessageBoxA(NULL, msg, "Fatal error in gc", MB_ICONERROR|MB_OK);
01068 #   else
01069       GC_err_printf1("%s\n", msg);
01070 #   endif
01071     if (GETENV("GC_LOOP_ON_ABORT") != NULL) {
01072            /* In many cases it's easier to debug a running process.   */
01073            /* It's arguably nicer to sleep, but that makes it harder  */
01074            /* to look at the thread if the debugger doesn't know much */
01075            /* about threads.                                          */
01076            for(;;) {}
01077     }
01078 #   if defined(MSWIN32) || defined(MSWINCE)
01079        DebugBreak();
01080 #   else
01081         (void) abort();
01082 #   endif
01083 }
01084 #endif
01085 
01086 void GC_enable()
01087 {
01088     LOCK();
01089     GC_dont_gc--;
01090     UNLOCK();
01091 }
01092 
01093 void GC_disable()
01094 {
01095     LOCK();
01096     GC_dont_gc++;
01097     UNLOCK();
01098 }
01099 
01100 /* Helper procedures for new kind creation.      */
01101 void ** GC_new_free_list_inner()
01102 {
01103     void *result = GC_INTERNAL_MALLOC((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
01104     if (result == 0) ABORT("Failed to allocate freelist for new kind");
01105     BZERO(result, (MAXOBJSZ+1)*sizeof(ptr_t));
01106     return result;
01107 }
01108 
01109 void ** GC_new_free_list()
01110 {
01111     void *result;
01112     LOCK(); DISABLE_SIGNALS();
01113     result = GC_new_free_list_inner();
01114     UNLOCK(); ENABLE_SIGNALS();
01115     return result;
01116 }
01117 
01118 int GC_new_kind_inner(fl, descr, adjust, clear)
01119 void **fl;
01120 GC_word descr;
01121 int adjust;
01122 int clear;
01123 {
01124     int result = GC_n_kinds++;
01125 
01126     if (GC_n_kinds > MAXOBJKINDS) ABORT("Too many kinds");
01127     GC_obj_kinds[result].ok_freelist = (ptr_t *)fl;
01128     GC_obj_kinds[result].ok_reclaim_list = 0;
01129     GC_obj_kinds[result].ok_descriptor = descr;
01130     GC_obj_kinds[result].ok_relocate_descr = adjust;
01131     GC_obj_kinds[result].ok_init = clear;
01132     return result;
01133 }
01134 
01135 int GC_new_kind(fl, descr, adjust, clear)
01136 void **fl;
01137 GC_word descr;
01138 int adjust;
01139 int clear;
01140 {
01141     int result;
01142     LOCK(); DISABLE_SIGNALS();
01143     result = GC_new_kind_inner(fl, descr, adjust, clear);
01144     UNLOCK(); ENABLE_SIGNALS();
01145     return result;
01146 }
01147 
01148 int GC_new_proc_inner(proc)
01149 GC_mark_proc proc;
01150 {
01151     int result = GC_n_mark_procs++;
01152 
01153     if (GC_n_mark_procs > MAX_MARK_PROCS) ABORT("Too many mark procedures");
01154     GC_mark_procs[result] = proc;
01155     return result;
01156 }
01157 
01158 int GC_new_proc(proc)
01159 GC_mark_proc proc;
01160 {
01161     int result;
01162     LOCK(); DISABLE_SIGNALS();
01163     result = GC_new_proc_inner(proc);
01164     UNLOCK(); ENABLE_SIGNALS();
01165     return result;
01166 }
01167 
01168 
01169 #if !defined(NO_DEBUGGING)
01170 
01171 void GC_dump()
01172 {
01173     GC_printf0("***Static roots:\n");
01174     GC_print_static_roots();
01175     GC_printf0("\n***Heap sections:\n");
01176     GC_print_heap_sects();
01177     GC_printf0("\n***Free blocks:\n");
01178     GC_print_hblkfreelist();
01179     GC_printf0("\n***Blocks in use:\n");
01180     GC_print_block_list();
01181     GC_printf0("\n***Finalization statistics:\n");
01182     GC_print_finalization_stats();
01183 }
01184 
01185 #endif /* NO_DEBUGGING */
01186 
01187 /* PLTSCHEME: GC_get_memory_use */
01188 static void get_size(struct hblk *h, word lptr)
01189 {
01190   hdr *hhdr = HDR(h);
01191   long bytes = WORDS_TO_BYTES(hhdr->hb_sz);
01192 
01193   bytes += HBLKSIZE-1;
01194   bytes &= ~(HBLKSIZE-1);
01195 
01196   *(long *)lptr += bytes;
01197 }
01198 long GC_get_memory_use()
01199 {
01200   long c = 0;
01201   LOCK();
01202   GC_apply_to_all_blocks(get_size, (word)&c);
01203   UNLOCK();
01204   return c;
01205 }