(linenum→info "unix/slp.c:2238")

gauche/0.8.12/gc/alloc.c

    1: /*
    2:  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
    3:  * Copyright (c) 1991-1996 by Xerox Corporation.  All rights reserved.
    4:  * Copyright (c) 1998 by Silicon Graphics.  All rights reserved.
    5:  * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
    6:  *
    7:  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
    8:  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
    9:  *
   10:  * Permission is hereby granted to use or copy this program
   11:  * for any purpose,  provided the above notices are retained on all copies.
   12:  * Permission to modify the code and to distribute modified code is granted,
   13:  * provided the above notices are retained, and a notice that the code was
   14:  * modified is included with the above copyright notice.
   15:  *
   16:  */
   17: 
   18: 
   19: # include "private/gc_priv.h"
   20: 
   21: # include <stdio.h>
   22: # if !defined(MACOS) && !defined(MSWINCE)
   23: #   include <signal.h>
   24: #   include <sys/types.h>
   25: # endif
   26: 
   27: /*
   28:  * Separate free lists are maintained for different sized objects
   29:  * up to MAXOBJSZ.
   30:  * The call GC_allocobj(i,k) ensures that the freelist for
   31:  * kind k objects of size i points to a non-empty
   32:  * free list. It returns a pointer to the first entry on the free list.
   33:  * In a single-threaded world, GC_allocobj may be called to allocate
   34:  * an object of (small) size i as follows:
   35:  *
   36:  *            opp = &(GC_objfreelist[i]);
   37:  *            if (*opp == 0) GC_allocobj(i, NORMAL);
   38:  *            ptr = *opp;
   39:  *            *opp = obj_link(ptr);
   40:  *
   41:  * Note that this is very fast if the free list is non-empty; it should
   42:  * only involve the execution of 4 or 5 simple instructions.
   43:  * All composite objects on freelists are cleared, except for
   44:  * their first word.
   45:  */
   46: 
   47: /*
   48:  *  The allocator uses GC_allochblk to allocate large chunks of objects.
   49:  * These chunks all start on addresses which are multiples of
   50:  * HBLKSZ.   Each allocated chunk has an associated header,
   51:  * which can be located quickly based on the address of the chunk.
   52:  * (See headers.c for details.) 
   53:  * This makes it possible to check quickly whether an
   54:  * arbitrary address corresponds to an object administered by the
   55:  * allocator.
   56:  */
   57: 
   58: word GC_non_gc_bytes = 0;  /* Number of bytes not intended to be collected */
   59: 
   60: word GC_gc_no = 0;
   61: 
   62: #ifndef SMALL_CONFIG
   63:   int GC_incremental = 0;  /* By default, stop the world.       */
   64: #endif
   65: 
   66: int GC_parallel = FALSE;   /* By default, parallel GC is off.   */
   67: 
   68: int GC_full_freq = 19;     /* Every 20th collection is a full    */
   69:                            /* collection, whether we need it         */
   70:                            /* or not.                                */
   71: 
   72: GC_bool GC_need_full_gc = FALSE;
   73:                            /* Need full GC do to heap growth.        */
   74: 
   75: #ifdef THREADS
   76:   GC_bool GC_world_stopped = FALSE;
   77: # define IF_THREADS(x) x
   78: #else
   79: # define IF_THREADS(x)
   80: #endif
   81: 
   82: word GC_used_heap_size_after_full = 0;
   83: 
   84: char * GC_copyright[] =
   85: {"Copyright 1988,1989 Hans-J. Boehm and Alan J. Demers ",
   86: "Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved. ",
   87: "Copyright (c) 1996-1998 by Silicon Graphics.  All rights reserved. ",
   88: "Copyright (c) 1999-2001 by Hewlett-Packard Company.  All rights reserved. ",
   89: "THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY",
   90: " EXPRESSED OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.",
   91: "See source code for details." };
   92: 
   93: # include "version.h"
   94: 
   95: #if defined(SAVE_CALL_CHAIN) && \
   96:         !(defined(REDIRECT_MALLOC) && defined(GC_HAVE_BUILTIN_BACKTRACE))
   97: #   define SAVE_CALL_CHAIN_IN_GC
   98:     /* This is only safe if the call chain save mechanism won't end up  */
   99:     /* calling GC_malloc.  The GNU C library documentation suggests     */
  100:     /* that backtrace doesn't use malloc, but at least the initial      */
  101:     /* call in some versions does seem to invoke the dynamic linker,    */
  102:     /* which uses malloc.                                               */
  103: #endif
  104: 
  105: /* some more variables */
  106: 
  107: extern signed_word GC_mem_found;  /* Number of reclaimed longwords      */
  108:                                   /* after garbage collection       */
  109: 
  110: GC_bool GC_dont_expand = 0;
  111: 
  112: word GC_free_space_divisor = 3;
  113: 
  114: extern GC_bool GC_collection_in_progress();
  115:                 /* Collection is in progress, or was abandoned.       */
  116: 
  117: int GC_never_stop_func GC_PROTO((void)) { return(0); }
  118: 
  119: unsigned long GC_time_limit = TIME_LIMIT;
  120: 
  121: CLOCK_TYPE GC_start_time;       /* Time at which we stopped world.  */
  122:                                 /* used only in GC_timeout_stop_func.       */
  123: 
  124: int GC_n_attempts = 0;          /* Number of attempts at finishing      */
  125:                                 /* collection within GC_time_limit. */
  126: 
  127: #if defined(SMALL_CONFIG) || defined(NO_CLOCK)
  128: #   define GC_timeout_stop_func GC_never_stop_func
  129: #else
  130:   int GC_timeout_stop_func GC_PROTO((void))
  131:   {
  132:     CLOCK_TYPE current_time;
  133:     static unsigned count = 0;
  134:     unsigned long time_diff;
  135:     
  136:     if ((count++ & 3) != 0) return(0);
  137:     GET_TIME(current_time);
  138:     time_diff = MS_TIME_DIFF(current_time,GC_start_time);
  139:     if (time_diff >= GC_time_limit) {
  140: #       ifdef CONDPRINT
  141:           if (GC_print_stats) {
  142:             GC_printf0("Abandoning stopped marking after ");
  143:             GC_printf1("%lu msecs", (unsigned long)time_diff);
  144:             GC_printf1("(attempt %ld)\n", (unsigned long) GC_n_attempts);
  145:           }
  146: #       endif
  147:         return(1);
  148:     }
  149:     return(0);
  150:   }
  151: #endif /* !SMALL_CONFIG */
  152: 
  153: /* Return the minimum number of words that must be allocated between    */
  154: /* collections to amortize the collection cost.                         */
  155: static word min_words_allocd()
  156: {
  157: #   ifdef THREADS
  158:         /* We punt, for now. */
  159:         register signed_word stack_size = 10000;
  160: #   else
  161:         int dummy;
  162:         register signed_word stack_size = (ptr_t)(&dummy) - GC_stackbottom;
  163: #   endif
  164:     word total_root_size;           /* includes double stack size,  */
  165:                                     /* since the stack is expensive     */
  166:                                     /* to scan.                         */
  167:     word scan_size;             /* Estimate of memory to be scanned        */
  168:                                 /* during normal GC.                        */
  169:     
  170:     if (stack_size < 0) stack_size = -stack_size;
  171:     total_root_size = 2 * stack_size + GC_root_size;
  172:     scan_size = BYTES_TO_WORDS(GC_heapsize - GC_large_free_bytes
  173:                                + (GC_large_free_bytes >> 2)
  174:                                    /* use a bit more of large empty heap */
  175:                                + total_root_size);
  176:     if (TRUE_INCREMENTAL) {
  177:         return scan_size / (2 * GC_free_space_divisor);
  178:     } else {
  179:         return scan_size / GC_free_space_divisor;
  180:     }
  181: }
  182: 
  183: /* Return the number of words allocated, adjusted for explicit storage  */
  184: /* management, etc..  This number is used in deciding when to trigger   */
  185: /* collections.                                                         */
  186: word GC_adj_words_allocd()
  187: {
  188:     register signed_word result;
  189:     register signed_word expl_managed =
  190:                 BYTES_TO_WORDS((long)GC_non_gc_bytes
  191:                                 - (long)GC_non_gc_bytes_at_gc);
  192:     
  193:     /* Don't count what was explicitly freed, or newly allocated for    */
  194:     /* explicit management.  Note that deallocating an explicitly       */
  195:     /* managed object should not alter result, assuming the client      */
  196:     /* is playing by the rules.                                         */
  197:     result = (signed_word)GC_words_allocd
  198:              - (signed_word)GC_mem_freed 
  199:              + (signed_word)GC_finalizer_mem_freed - expl_managed;
  200:     if (result > (signed_word)GC_words_allocd) {
  201:         result = GC_words_allocd;
  202:         /* probably client bug or unfortunate scheduling */
  203:     }
  204:     result += GC_words_finalized;
  205:         /* We count objects enqueued for finalization as though they       */
  206:         /* had been reallocated this round. Finalization is user   */
  207:         /* visible progress.  And if we don't count this, we have  */
  208:         /* stability problems for programs that finalize all objects.      */
  209:     if ((signed_word)(GC_words_wasted >> 3) < result)
  210:         result += GC_words_wasted;
  211:         /* This doesn't reflect useful work.  But if there is lots of     */
  212:         /* new fragmentation, the same is probably true of the heap,      */
  213:         /* and the collection will be correspondingly cheaper.            */
  214:     if (result < (signed_word)(GC_words_allocd >> 3)) {
  215:         /* Always count at least 1/8 of the allocations.  We don't want    */
  216:         /* to collect too infrequently, since that would inhibit   */
  217:         /* coalescing of free storage blocks.                              */
  218:         /* This also makes us partially robust against client bugs.        */
  219:         return(GC_words_allocd >> 3);
  220:     } else {
  221:         return(result);
  222:     }
  223: }
  224: 
  225: 
  226: /* Clear up a few frames worth of garbage left at the top of the stack. */
  227: /* This is used to prevent us from accidentally treating garbade left   */
  228: /* on the stack by other parts of the collector as roots.  This         */
  229: /* differs from the code in misc.c, which actually tries to keep the    */
  230: /* stack clear of long-lived, client-generated garbage.                 */
  231: void GC_clear_a_few_frames()
  232: {
  233: #   define NWORDS 64
  234:     word frames[NWORDS];
  235:     /* Some compilers will warn that frames was set but never used.     */
  236:     /* That's the whole idea ...                                        */
  237:     register int i;
  238:     
  239:     for (i = 0; i < NWORDS; i++) frames[i] = 0;
  240: }
  241: 
  242: /* Heap size at which we need a collection to avoid expanding past      */
  243: /* limits used by blacklisting.                                         */
  244: static word GC_collect_at_heapsize = (word)(-1);
  245: 
  246: /* Have we allocated enough to amortize a collection? */
  247: GC_bool GC_should_collect()
  248: {
  249:     return(GC_adj_words_allocd() >= min_words_allocd()
  250:            || GC_heapsize >= GC_collect_at_heapsize);
  251: }
  252: 
  253: 
  254: void GC_notify_full_gc()
  255: {
  256:     if (GC_start_call_back != (void (*) GC_PROTO((void)))0) {
  257:         (*GC_start_call_back)();
  258:     }
  259: }
  260: 
  261: GC_bool GC_is_full_gc = FALSE;
  262: 
  263: /* 
  264:  * Initiate a garbage collection if appropriate.
  265:  * Choose judiciously
  266:  * between partial, full, and stop-world collections.
  267:  * Assumes lock held, signals disabled.
  268:  */
  269: void GC_maybe_gc()
  270: {
  271:     static int n_partial_gcs = 0;
  272: 
  273:     if (GC_should_collect()) {
  274:         if (!GC_incremental) {
  275:             GC_gcollect_inner();
  276:             n_partial_gcs = 0;
  277:             return;
  278:         } else {
  279: #         ifdef PARALLEL_MARK
  280:             GC_wait_for_reclaim();
  281: #         endif
  282:           if (GC_need_full_gc || n_partial_gcs >= GC_full_freq) {
  283: #           ifdef CONDPRINT
  284:               if (GC_print_stats) {
  285:                 GC_printf2(
  286:                   "***>Full mark for collection %lu after %ld allocd bytes\n",
  287:                   (unsigned long) GC_gc_no+1,
  288:                  (long)WORDS_TO_BYTES(GC_words_allocd));
  289:               }
  290: #           endif
  291:             GC_promote_black_lists();
  292:             (void)GC_reclaim_all((GC_stop_func)0, TRUE);
  293:             GC_clear_marks();
  294:             n_partial_gcs = 0;
  295:             GC_notify_full_gc();
  296:             GC_is_full_gc = TRUE;
  297:           } else {
  298:             n_partial_gcs++;
  299:           }
  300:         }
  301:         /* We try to mark with the world stopped.       */
  302:         /* If we run out of time, this turns into       */
  303:         /* incremental marking.                 */
  304: #       ifndef NO_CLOCK
  305:           if (GC_time_limit != GC_TIME_UNLIMITED) { GET_TIME(GC_start_time); }
  306: #       endif
  307:         if (GC_stopped_mark(GC_time_limit == GC_TIME_UNLIMITED? 
  308:                             GC_never_stop_func : GC_timeout_stop_func)) {
  309: #           ifdef SAVE_CALL_CHAIN_IN_GC
  310:                 GC_save_callers(GC_last_stack);
  311: #           endif
  312:             GC_finish_collection();
  313:         } else {
  314:             if (!GC_is_full_gc) {
  315:                 /* Count this as the first attempt */
  316:                 GC_n_attempts++;
  317:             }
  318:         }
  319:     }
  320: }
  321: 
  322: 
  323: /*
  324:  * Stop the world garbage collection.  Assumes lock held, signals disabled.
  325:  * If stop_func is not GC_never_stop_func, then abort if stop_func returns TRUE.
  326:  * Return TRUE if we successfully completed the collection.
  327:  */
  328: GC_bool GC_try_to_collect_inner(stop_func)
  329: GC_stop_func stop_func;
  330: {
  331: #   ifdef CONDPRINT
  332:         CLOCK_TYPE start_time, current_time;
  333: #   endif
  334:     if (GC_dont_gc) return FALSE;
  335:     if (GC_incremental && GC_collection_in_progress()) {
  336: #   ifdef CONDPRINT
  337:       if (GC_print_stats) {
  338:         GC_printf0(
  339:             "GC_try_to_collect_inner: finishing collection in progress\n");
  340:       }
  341: #   endif /* CONDPRINT */
  342:       /* Just finish collection already in progress.    */
  343:         while(GC_collection_in_progress()) {
  344:             if (stop_func()) return(FALSE);
  345:             GC_collect_a_little_inner(1);
  346:         }
  347:     }
  348:     if (stop_func == GC_never_stop_func) GC_notify_full_gc();
  349: #   ifdef CONDPRINT
  350:       if (GC_print_stats) {
  351:         if (GC_print_stats) GET_TIME(start_time);
  352:         GC_printf2(
  353:            "Initiating full world-stop collection %lu after %ld allocd bytes\n",
  354:            (unsigned long) GC_gc_no+1,
  355:            (long)WORDS_TO_BYTES(GC_words_allocd));
  356:       }
  357: #   endif
  358:     GC_promote_black_lists();
  359:     /* Make sure all blocks have been reclaimed, so sweep routines      */
  360:     /* don't see cleared mark bits.                                     */
  361:     /* If we're guaranteed to finish, then this is unnecessary.         */
  362:     /* In the find_leak case, we have to finish to guarantee that       */
  363:     /* previously unmarked objects are not reported as leaks.           */
  364: #       ifdef PARALLEL_MARK
  365:             GC_wait_for_reclaim();
  366: #       endif
  367:         if ((GC_find_leak || stop_func != GC_never_stop_func)
  368:             && !GC_reclaim_all(stop_func, FALSE)) {
  369:             /* Aborted.  So far everything is still consistent.        */
  370:             return(FALSE);
  371:         }
  372:     GC_invalidate_mark_state();  /* Flush mark stack.   */
  373:     GC_clear_marks();
  374: #   ifdef SAVE_CALL_CHAIN_IN_GC
  375:         GC_save_callers(GC_last_stack);
  376: #   endif
  377:     GC_is_full_gc = TRUE;
  378:     if (!GC_stopped_mark(stop_func)) {
  379:       if (!GC_incremental) {
  380:         /* We're partially done and have no way to complete or use         */
  381:         /* current work.  Reestablish invariants as cheaply as             */
  382:         /* possible.                                                       */
  383:         GC_invalidate_mark_state();
  384:         GC_unpromote_black_lists();
  385:       } /* else we claim the world is already still consistent.  We'll  */
  386:         /* finish incrementally.                                        */
  387:       return(FALSE);
  388:     }
  389:     GC_finish_collection();
  390: #   if defined(CONDPRINT)
  391:       if (GC_print_stats) {
  392:         GET_TIME(current_time);
  393:         GC_printf1("Complete collection took %lu msecs\n",
  394:                    MS_TIME_DIFF(current_time,start_time));
  395:       }
  396: #   endif
  397:     return(TRUE);
  398: }
  399: 
  400: 
  401: 
  402: /*
  403:  * Perform n units of garbage collection work.  A unit is intended to touch
  404:  * roughly GC_RATE pages.  Every once in a while, we do more than that.
  405:  * This needs to be a fairly large number with our current incremental
  406:  * GC strategy, since otherwise we allocate too much during GC, and the
  407:  * cleanup gets expensive.
  408:  */
  409: # define GC_RATE 10 
  410: # define MAX_PRIOR_ATTEMPTS 1
  411:         /* Maximum number of prior attempts at world stop marking     */
  412:         /* A value of 1 means that we finish the second time, no matter */
  413:         /* how long it takes.  Doesn't count the initial root scan    */
  414:         /* for a full GC.                                             */
  415: 
  416: int GC_deficit = 0;     /* The number of extra calls to GC_mark_some        */
  417:                         /* that we have made.                                */
  418: 
  419: void GC_collect_a_little_inner(n)
  420: int n;
  421: {
  422:     register int i;
  423:     
  424:     if (GC_dont_gc) return;
  425:     if (GC_incremental && GC_collection_in_progress()) {
  426:         for (i = GC_deficit; i < GC_RATE*n; i++) {
  427:             if (GC_mark_some((ptr_t)0)) {
  428:                 /* Need to finish a collection */
  429: #               ifdef SAVE_CALL_CHAIN_IN_GC
  430:                     GC_save_callers(GC_last_stack);
  431: #               endif
  432: #               ifdef PARALLEL_MARK
  433:                     GC_wait_for_reclaim();
  434: #               endif
  435:                 if (GC_n_attempts < MAX_PRIOR_ATTEMPTS
  436:                     && GC_time_limit != GC_TIME_UNLIMITED) {
  437:                   GET_TIME(GC_start_time);
  438:                   if (!GC_stopped_mark(GC_timeout_stop_func)) {
  439:                     GC_n_attempts++;
  440:                     break;
  441:                   }
  442:                 } else {
  443:                   (void)GC_stopped_mark(GC_never_stop_func);
  444:                 }
  445:                 GC_finish_collection();
  446:                 break;
  447:             }
  448:         }
  449:         if (GC_deficit > 0) GC_deficit -= GC_RATE*n;
  450:         if (GC_deficit < 0) GC_deficit = 0;
  451:     } else {
  452:         GC_maybe_gc();
  453:     }
  454: }
  455: 
  456: int GC_collect_a_little GC_PROTO(())
  457: {
  458:     int result;
  459:     DCL_LOCK_STATE;
  460: 
  461:     DISABLE_SIGNALS();
  462:     LOCK();
  463:     GC_collect_a_little_inner(1);
  464:     result = (int)GC_collection_in_progress();
  465:     UNLOCK();
  466:     ENABLE_SIGNALS();
  467:     if (!result && GC_debugging_started) GC_print_all_smashed();
  468:     return(result);
  469: }
  470: 
  471: /*
  472:  * Assumes lock is held, signals are disabled.
  473:  * We stop the world.
  474:  * If stop_func() ever returns TRUE, we may fail and return FALSE.
  475:  * Increment GC_gc_no if we succeed.
  476:  */
  477: GC_bool GC_stopped_mark(stop_func)
  478: GC_stop_func stop_func;
  479: {
  480:     register int i;
  481:     int dummy;
  482: #   if defined(PRINTTIMES) || defined(CONDPRINT)
  483:         CLOCK_TYPE start_time, current_time;
  484: #   endif
  485:         
  486: #   ifdef PRINTTIMES
  487:         GET_TIME(start_time);
  488: #   endif
  489: #   if defined(CONDPRINT) && !defined(PRINTTIMES)
  490:         if (GC_print_stats) GET_TIME(start_time);
  491: #   endif
  492: #   if defined(REGISTER_LIBRARIES_EARLY)
  493:         GC_cond_register_dynamic_libraries();
  494: #   endif
  495:     STOP_WORLD();
  496:     IF_THREADS(GC_world_stopped = TRUE);
  497: #   ifdef CONDPRINT
  498:       if (GC_print_stats) {
  499:         GC_printf1("--> Marking for collection %lu ",
  500:                    (unsigned long) GC_gc_no + 1);
  501:         GC_printf2("after %lu allocd bytes + %lu wasted bytes\n",
  502:                   (unsigned long) WORDS_TO_BYTES(GC_words_allocd),
  503:                   (unsigned long) WORDS_TO_BYTES(GC_words_wasted));
  504:       }
  505: #   endif
  506: #   ifdef MAKE_BACK_GRAPH
  507:       if (GC_print_back_height) {
  508:         GC_build_back_graph();
  509:       }
  510: #   endif
  511: 
  512:     /* Mark from all roots.  */
  513:         /* Minimize junk left in my registers and on the stack */
  514:             GC_clear_a_few_frames();
  515:             GC_noop(0,0,0,0,0,0);
  516:         GC_initiate_gc();
  517:         for(i = 0;;i++) {
  518:             if ((*stop_func)()) {
  519: #                   ifdef CONDPRINT
  520:                       if (GC_print_stats) {
  521:                       GC_printf0("Abandoned stopped marking after ");
  522:                         GC_printf1("%lu iterations\n",
  523:                                    (unsigned long)i);
  524:                       }
  525: #                   endif
  526:                     GC_deficit = i; /* Give the mutator a chance. */
  527:                     IF_THREADS(GC_world_stopped = FALSE);
  528:                     START_WORLD();
  529:                     return(FALSE);
  530:             }
  531:             if (GC_mark_some((ptr_t)(&dummy))) break;
  532:         }
  533:         
  534:     GC_gc_no++;
  535: #   ifdef PRINTSTATS
  536:       GC_printf2("Collection %lu reclaimed %ld bytes",
  537:                   (unsigned long) GC_gc_no - 1,
  538:                  (long)WORDS_TO_BYTES(GC_mem_found));
  539: #   else
  540: #     ifdef CONDPRINT
  541:         if (GC_print_stats) {
  542:           GC_printf1("Collection %lu finished", (unsigned long) GC_gc_no - 1);
  543:         }
  544: #     endif
  545: #   endif /* !PRINTSTATS */
  546: #   ifdef CONDPRINT
  547:       if (GC_print_stats) {
  548:         GC_printf1(" ---> heapsize = %lu bytes\n",
  549:                    (unsigned long) GC_heapsize);
  550:         /* Printf arguments may be pushed in funny places.  Clear the   */
  551:         /* space.                                                       */
  552:         GC_printf0("");
  553:       }
  554: #   endif  /* CONDPRINT  */
  555: 
  556:     /* Check all debugged objects for consistency */
  557:         if (GC_debugging_started) {
  558:             (*GC_check_heap)();
  559:         }
  560:     
  561:     IF_THREADS(GC_world_stopped = FALSE);
  562:     START_WORLD();
  563: #   ifdef PRINTTIMES
  564:         GET_TIME(current_time);
  565:         GC_printf1("World-stopped marking took %lu msecs\n",
  566:                    MS_TIME_DIFF(current_time,start_time));
  567: #   else
  568: #     ifdef CONDPRINT
  569:         if (GC_print_stats) {
  570:           GET_TIME(current_time);
  571:           GC_printf1("World-stopped marking took %lu msecs\n",
  572:                      MS_TIME_DIFF(current_time,start_time));
  573:         }
  574: #     endif
  575: #   endif
  576:     return(TRUE);
  577: }
  578: 
  579: /* Set all mark bits for the free list whose first entry is q   */
  580: #ifdef __STDC__
  581:   void GC_set_fl_marks(ptr_t q)
  582: #else
  583:   void GC_set_fl_marks(q)
  584:   ptr_t q;
  585: #endif
  586: {
  587:    ptr_t p;
  588:    struct hblk * h, * last_h = 0;
  589:    hdr *hhdr;
  590:    int word_no;
  591: 
  592:    for (p = q; p != 0; p = obj_link(p)){