finalize.c

   1 /*
   2  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
   3  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
   4
   5  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
   6  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
   7  *
   8  * Permission is hereby granted to use or copy this program
   9  * for any purpose,  provided the above notices are retained on all copies.
  10  * Permission to modify the code and to distribute modified code is granted,
  11  * provided the above notices are retained, and a notice that the code was
  12  * modified is included with the above copyright notice.
  13  */
  14 /* Boehm, November 8, 1994 5:35 pm PST */
  15 # define I_HIDE_POINTERS
  16 # include "gc_priv.h"
  17 # include "gc_mark.h"
  18
  19 /* Type of mark procedure used for marking from finalizable object.     */
  20 /* This procedure normally does not mark the object, only its           */
  21 /* descendents.                                                         */
  22 typedef void finalization_mark_proc(/* ptr_t finalizable_obj_ptr */);
  23
  24 # define HASH3(addr,size,log_size) \
  25     ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+(log_size)))) \
  26     & ((size) - 1))
  27 #define HASH2(addr,log_size) HASH3(addr, 1 << log_size, log_size)
  28
  29 struct hash_chain_entry {
  30     word hidden_key;
  31     struct hash_chain_entry * next;
  32 };
  33
  34 unsigned GC_finalization_failures = 0;
  35         /* Number of finalization requests that failed for lack of memory. */
  36
  37 static struct disappearing_link {
  38     struct hash_chain_entry prolog;
  39 #   define dl_hidden_link prolog.hidden_key
  40                                 /* Field to be cleared.         */
  41 #   define dl_next(x) (struct disappearing_link *)((x) -> prolog.next)
  42 #   define dl_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
  43
  44     word dl_hidden_obj;         /* Pointer to object base       */
  45 } **dl_head = 0;
  46
  47 static signed_word log_dl_table_size = -1;
  48                         /* Binary log of                                */
  49                         /* current size of array pointed to by dl_head. */
  50                         /* -1 ==> size is 0.                            */
  51
  52 word GC_dl_entries = 0; /* Number of entries currently in disappearing  */
  53                         /* link table.                                  */
  54
  55 static struct finalizable_object {
  56     struct hash_chain_entry prolog;
  57 #   define fo_hidden_base prolog.hidden_key
  58                                 /* Pointer to object base.      */
  59 #   define fo_next(x) (struct finalizable_object *)((x) -> prolog.next)
  60 #   define fo_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
  61     GC_finalization_proc fo_fn; /* Finalizer.                   */
  62     ptr_t fo_client_data;
  63     word fo_object_size;        /* In bytes.                    */
  64     finalization_mark_proc * fo_mark_proc;      /* Mark-through procedure */
  65 } **fo_head = 0;
  66
  67 struct finalizable_object * GC_finalize_now = 0;
  68         /* LIst of objects that should be finalized now.        */
  69
  70 static signed_word log_fo_table_size = -1;
  71
  72 word GC_fo_entries = 0;
  73
  74 # ifdef SRC_M3
  75 void GC_push_finalizer_structures()
  76 {
  77     GC_push_all((ptr_t)(&dl_head), (ptr_t)(&dl_head) + sizeof(word));
  78     GC_push_all((ptr_t)(&fo_head), (ptr_t)(&fo_head) + sizeof(word));
  79 }
  80 # endif
  81
  82 # define ALLOC(x, t) t *x = GC_NEW(t)
  83
  84 /* Double the size of a hash table. *size_ptr is the log of its current */
  85 /* size.  May be a noop.                                                */
  86 /* *table is a pointer to an array of hash headers.  If we succeed, we  */
  87 /* update both *table and *log_size_ptr.                                */
  88 /* Lock is held.  Signals are disabled.                                 */
  89 void GC_grow_table(table, log_size_ptr)
  90 struct hash_chain_entry ***table;
  91 signed_word * log_size_ptr;
  92 {
  93     register word i;
  94     register struct hash_chain_entry *p;
  95     int log_old_size = *log_size_ptr;
  96     register int log_new_size = log_old_size + 1;
  97     word old_size = ((log_old_size == -1)? 0: (1 << log_old_size));
  98     register word new_size = 1 << log_new_size;
  99     struct hash_chain_entry **new_table = (struct hash_chain_entry **)
 100         GC_generic_malloc_inner_ignore_off_page(
 101                 (size_t)new_size * sizeof(struct hash_chain_entry *), NORMAL);
 102
 103     if (new_table == 0) {
 104         if (table == 0) {
 105             ABORT("Insufficient space for initial table allocation");
 106         } else {
 107             return;
 108         }
 109     }
 110     for (i = 0; i < old_size; i++) {
 111       p = (*table)[i];
 112       while (p != 0) {
 113         register ptr_t real_key = (ptr_t)REVEAL_POINTER(p -> hidden_key);
 114         register struct hash_chain_entry *next = p -> next;
 115         register int new_hash = HASH3(real_key, new_size, log_new_size);
 116
 117         p -> next = new_table[new_hash];
 118         new_table[new_hash] = p;
 119         p = next;
 120       }
 121     }
 122     *log_size_ptr = log_new_size;
 123     *table = new_table;
 124 }
 125
 126
 127 int GC_register_disappearing_link(link)
 128 extern_ptr_t * link;
 129 {
 130     ptr_t base;
 131
 132     base = (ptr_t)GC_base((extern_ptr_t)link);
 133     if (base == 0)
 134         ABORT("Bad arg to GC_register_disappearing_link");
 135     return(GC_general_register_disappearing_link(link, base));
 136 }
 137
 138 int GC_general_register_disappearing_link(link, obj)
 139 extern_ptr_t * link;
 140 extern_ptr_t obj;
 141 {
 142     struct disappearing_link *curr_dl;
 143     int index;
 144     struct disappearing_link * new_dl;
 145     DCL_LOCK_STATE;
 146
 147     if ((word)link & (ALIGNMENT-1))
 148         ABORT("Bad arg to GC_general_register_disappearing_link");
 149 #   ifdef THREADS
 150         DISABLE_SIGNALS();
 151         LOCK();
 152 #   endif
 153     if (log_dl_table_size == -1
 154         || GC_dl_entries > ((word)1 << log_dl_table_size)) {
 155 #       ifndef THREADS
 156             DISABLE_SIGNALS();
 157 #       endif
 158         GC_grow_table((struct hash_chain_entry ***)(&dl_head),
 159                       &log_dl_table_size);
 160 #       ifdef PRINTSTATS
 161             GC_printf1("Grew dl table to %lu entries\n",
 162                         (unsigned long)(1 << log_dl_table_size));
 163 #       endif
 164 #       ifndef THREADS
 165             ENABLE_SIGNALS();
 166 #       endif
 167     }
 168     index = HASH2(link, log_dl_table_size);
 169     curr_dl = dl_head[index];
 170     for (curr_dl = dl_head[index]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
 171         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
 172             curr_dl -> dl_hidden_obj = HIDE_POINTER(obj);
 173 #           ifdef THREADS
 174                 UNLOCK();
 175                 ENABLE_SIGNALS();
 176 #           endif
 177             return(1);
 178         }
 179     }
 180 #   ifdef THREADS
 181       new_dl = (struct disappearing_link *)
 182         GC_generic_malloc_inner(sizeof(struct disappearing_link),NORMAL);
 183 #   else
 184       new_dl = GC_NEW(struct disappearing_link);
 185 #   endif
 186     if (new_dl != 0) {
 187         new_dl -> dl_hidden_obj = HIDE_POINTER(obj);
 188         new_dl -> dl_hidden_link = HIDE_POINTER(link);
 189         dl_set_next(new_dl, dl_head[index]);
 190         dl_head[index] = new_dl;
 191         GC_dl_entries++;
 192     } else {
 193         GC_finalization_failures++;
 194     }
 195 #   ifdef THREADS
 196         UNLOCK();
 197         ENABLE_SIGNALS();
 198 #   endif
 199     return(0);
 200 }
 201
 202 int GC_unregister_disappearing_link(link)
 203 extern_ptr_t * link;
 204 {
 205     struct disappearing_link *curr_dl, *prev_dl;
 206     int index;
 207     DCL_LOCK_STATE;
 208
 209     DISABLE_SIGNALS();
 210     LOCK();
 211     index = HASH2(link, log_dl_table_size);
 212     if (((unsigned long)link & (ALIGNMENT-1))) goto out;
 213     prev_dl = 0; curr_dl = dl_head[index];
 214     while (curr_dl != 0) {
 215         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
 216             if (prev_dl == 0) {
 217                 dl_head[index] = dl_next(curr_dl);
 218             } else {
 219                 dl_set_next(prev_dl, dl_next(curr_dl));
 220             }
 221             GC_dl_entries--;
 222             UNLOCK();
 223             ENABLE_SIGNALS();
 224             GC_free((extern_ptr_t)curr_dl);
 225             return(1);
 226         }
 227         prev_dl = curr_dl;
 228         curr_dl = dl_next(curr_dl);
 229     }
 230 out:
 231     UNLOCK();
 232     ENABLE_SIGNALS();
 233     return(0);
 234 }
 235
 236 /* Possible finalization_marker procedures.  Note that mark stack       */
 237 /* overflow is handled by the caller, and is not a disaster.            */
 238 void GC_normal_finalize_mark_proc(p)
 239 ptr_t p;
 240 {
 241     hdr * hhdr = HDR(p);
 242
 243     PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top,
 244              &(GC_mark_stack[GC_mark_stack_size]));
 245 }
 246
 247 /* This only pays very partial attention to the mark descriptor.        */
 248 /* It does the right thing for normal and atomic objects, and treats    */
 249 /* most others as normal.                                               */
 250 void GC_ignore_self_finalize_mark_proc(p)
 251 ptr_t p;
 252 {
 253     hdr * hhdr = HDR(p);
 254     word descr = hhdr -> hb_descr;
 255     ptr_t q, r;
 256     ptr_t limit;
 257
 258     if ((descr & DS_TAGS) == DS_LENGTH) {
 259        limit = p + descr - sizeof(word);
 260     } else {
 261        limit = p + WORDS_TO_BYTES(hhdr -> hb_sz - 1);
 262     }
 263     for (q = p; q <= limit; q += ALIGNMENT) {
 264         r = *(ptr_t *)q;
 265         if (r < p || r > limit) {
 266             GC_PUSH_ONE_HEAP((word)r);
 267         }
 268     }
 269 }
 270
 271 /*ARGSUSED*/
 272 void GC_null_finalize_mark_proc(p)
 273 ptr_t p;
 274 {
 275 }
 276
 277
 278
 279 /* Register a finalization function.  See gc.h for details.     */
 280 /* in the nonthreads case, we try to avoid disabling signals,   */
 281 /* since it can be expensive.  Threads packages typically       */
 282 /* make it cheaper.                                             */
 283 void GC_register_finalizer_inner(obj, fn, cd, ofn, ocd, mp)
 284 extern_ptr_t obj;
 285 GC_finalization_proc fn;
 286 extern_ptr_t cd;
 287 GC_finalization_proc * ofn;
 288 extern_ptr_t * ocd;
 289 finalization_mark_proc * mp;
 290 {
 291     ptr_t base;
 292     struct finalizable_object * curr_fo, * prev_fo;
 293     int index;
 294     struct finalizable_object *new_fo;
 295     DCL_LOCK_STATE;
 296
 297 #   ifdef THREADS
 298         DISABLE_SIGNALS();
 299         LOCK();
 300 #   endif
 301     if (log_fo_table_size == -1
 302         || GC_fo_entries > ((word)1 << log_fo_table_size)) {
 303 #       ifndef THREADS
 304             DISABLE_SIGNALS();
 305 #       endif
 306         GC_grow_table((struct hash_chain_entry ***)(&fo_head),
 307                       &log_fo_table_size);
 308 #       ifdef PRINTSTATS
 309             GC_printf1("Grew fo table to %lu entries\n",
 310                         (unsigned long)(1 << log_fo_table_size));
 311 #       endif
 312 #       ifndef THREADS
 313             ENABLE_SIGNALS();
 314 #       endif
 315     }
 316     /* in the THREADS case signals are disabled and we hold allocation  */
 317     /* lock; otherwise neither is true.  Proceed carefully.             */
 318     base = (ptr_t)obj;
 319     index = HASH2(base, log_fo_table_size);
 320     prev_fo = 0; curr_fo = fo_head[index];
 321     while (curr_fo != 0) {
 322         if (curr_fo -> fo_hidden_base == HIDE_POINTER(base)) {
 323             /* Interruption by a signal in the middle of this   */
 324             /* should be safe.  The client may see only *ocd    */
 325             /* updated, but we'll declare that to be his        */
 326             /* problem.                                         */
 327             if (ocd) *ocd = (extern_ptr_t) curr_fo -> fo_client_data;
 328             if (ofn) *ofn = curr_fo -> fo_fn;
 329             /* Delete the structure for base. */
 330                 if (prev_fo == 0) {
 331                   fo_head[index] = fo_next(curr_fo);
 332                 } else {
 333                   fo_set_next(prev_fo, fo_next(curr_fo));
 334                 }
 335             if (fn == 0) {
 336                 GC_fo_entries--;
 337                   /* May not happen if we get a signal.  But a high     */
 338                   /* estimate will only make the table larger than      */
 339                   /* necessary.                                         */
 340 #               ifndef THREADS
 341                   GC_free((extern_ptr_t)curr_fo);
 342 #               endif
 343             } else {
 344                 curr_fo -> fo_fn = fn;
 345                 curr_fo -> fo_client_data = (ptr_t)cd;
 346                 curr_fo -> fo_mark_proc = mp;
 347                 /* Reinsert it.  We deleted it first to maintain        */
 348                 /* consistency in the event of a signal.                */
 349                 if (prev_fo == 0) {
 350                   fo_head[index] = curr_fo;
 351                 } else {
 352                   fo_set_next(prev_fo, curr_fo);
 353                 }
 354             }
 355 #           ifdef THREADS
 356                 UNLOCK();
 357                 ENABLE_SIGNALS();
 358 #           endif
 359             return;
 360         }
 361         prev_fo = curr_fo;
 362         curr_fo = fo_next(curr_fo);
 363     }
 364     if (ofn) *ofn = 0;
 365     if (ocd) *ocd = 0;
 366     if (fn == 0) {
 367 #       ifdef THREADS
 368             UNLOCK();
 369             ENABLE_SIGNALS();
 370 #       endif
 371         return;
 372     }
 373 #   ifdef THREADS
 374       new_fo = (struct finalizable_object *)
 375         GC_generic_malloc_inner(sizeof(struct finalizable_object),NORMAL);
 376 #   else
 377       new_fo = GC_NEW(struct finalizable_object);
 378 #   endif
 379     if (new_fo != 0) {
 380         new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
 381         new_fo -> fo_fn = fn;
 382         new_fo -> fo_client_data = (ptr_t)cd;
 383         new_fo -> fo_object_size = GC_size(base);
 384         new_fo -> fo_mark_proc = mp;
 385         fo_set_next(new_fo, fo_head[index]);
 386         GC_fo_entries++;
 387         fo_head[index] = new_fo;
 388     } else {
 389         GC_finalization_failures++;
 390     }
 391 #   ifdef THREADS
 392         UNLOCK();
 393         ENABLE_SIGNALS();
 394 #   endif
 395 }
 396
 397 # if defined(__STDC__)
 398     void GC_register_finalizer(void * obj,
 399                                GC_finalization_proc fn, void * cd,
 400                                GC_finalization_proc *ofn, void ** ocd)
 401 # else
 402     void GC_register_finalizer(obj, fn, cd, ofn, ocd)
 403     extern_ptr_t obj;
 404     GC_finalization_proc fn;
 405     extern_ptr_t cd;
 406     GC_finalization_proc * ofn;
 407     extern_ptr_t * ocd;
 408 # endif
 409 {
 410     GC_register_finalizer_inner(obj, fn, cd, ofn,
 411                                 ocd, GC_normal_finalize_mark_proc);
 412 }
 413
 414 # if defined(__STDC__)
 415     void GC_register_finalizer_ignore_self(void * obj,
 416                                GC_finalization_proc fn, void * cd,
 417                                GC_finalization_proc *ofn, void ** ocd)
 418 # else
 419     void GC_register_finalizer_ignore_self(obj, fn, cd, ofn, ocd)
 420     extern_ptr_t obj;
 421     GC_finalization_proc fn;
 422     extern_ptr_t cd;
 423     GC_finalization_proc * ofn;
 424     extern_ptr_t * ocd;
 425 # endif
 426 {
 427     GC_register_finalizer_inner(obj, fn, cd, ofn,
 428                                 ocd, GC_ignore_self_finalize_mark_proc);
 429 }
 430
 431 # if defined(__STDC__)
 432     void GC_register_finalizer_no_order(void * obj,
 433                                GC_finalization_proc fn, void * cd,
 434                                GC_finalization_proc *ofn, void ** ocd)
 435 # else
 436     void GC_register_finalizer_no_order(obj, fn, cd, ofn, ocd)
 437     extern_ptr_t obj;
 438     GC_finalization_proc fn;
 439     extern_ptr_t cd;
 440     GC_finalization_proc * ofn;
 441     extern_ptr_t * ocd;
 442 # endif
 443 {
 444     GC_register_finalizer_inner(obj, fn, cd, ofn,
 445                                 ocd, GC_null_finalize_mark_proc);
 446 }
 447
 448
 449 /* Called with world stopped.  Cause disappearing links to disappear,   */
 450 /* and invoke finalizers.                                               */
 451 void GC_finalize()
 452 {
 453     struct disappearing_link * curr_dl, * prev_dl, * next_dl;
 454     struct finalizable_object * curr_fo, * prev_fo, * next_fo;
 455     ptr_t real_ptr, real_link;
 456     register int i;
 457     int dl_size = (log_dl_table_size == -1 ) ? 0 : (1 << log_dl_table_size);
 458     int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
 459
 460   /* Make disappearing links disappear */
 461     for (i = 0; i < dl_size; i++) {
 462       curr_dl = dl_head[i];
 463       prev_dl = 0;
 464       while (curr_dl != 0) {
 465         real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
 466         real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
 467         if (!GC_is_marked(real_ptr)) {
 468             *(word *)real_link = 0;
 469             next_dl = dl_next(curr_dl);
 470             if (prev_dl == 0) {
 471                 dl_head[i] = next_dl;
 472             } else {
 473                 dl_set_next(prev_dl, next_dl);
 474             }
 475             GC_clear_mark_bit((ptr_t)curr_dl);
 476             GC_dl_entries--;
 477             curr_dl = next_dl;
 478         } else {
 479             prev_dl = curr_dl;
 480             curr_dl = dl_next(curr_dl);
 481         }
 482       }
 483     }
 484   /* Mark all objects reachable via chains of 1 or more pointers        */
 485   /* from finalizable objects.                                          */
 486 #   ifdef PRINTSTATS
 487         if (GC_mark_state != MS_NONE) ABORT("Bad mark state");
 488 #   endif
 489     for (i = 0; i < fo_size; i++) {
 490       for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
 491         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
 492         if (!GC_is_marked(real_ptr)) {
 493             (*(curr_fo -> fo_mark_proc))(real_ptr);
 494             while (!GC_mark_stack_empty()) GC_mark_from_mark_stack();
 495             if (GC_mark_state != MS_NONE) {
 496                 /* Mark stack overflowed. Very unlikely. */
 497 #               ifdef PRINTSTATS
 498                     if (GC_mark_state != MS_INVALID) ABORT("Bad mark state");
 499                     GC_printf0("Mark stack overflowed in finalization!!\n");
 500 #               endif
 501                 /* Make mark bits consistent again.  Forget about       */
 502                 /* finalizing this object for now.                      */
 503                     GC_set_mark_bit(real_ptr);
 504                     while (!GC_mark_some());
 505             }
 506             /*
 507             if (GC_is_marked(real_ptr)) {
 508                 --> Report finalization cycle here, if desired
 509             }
 510             */
 511         }
 512
 513       }
 514     }
 515   /* Enqueue for finalization all objects that are still                */
 516   /* unreachable.                                                       */
 517     for (i = 0; i < fo_size; i++) {
 518       curr_fo = fo_head[i];
 519       prev_fo = 0;
 520       while (curr_fo != 0) {
 521         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
 522         if (!GC_is_marked(real_ptr)) {
 523             GC_set_mark_bit(real_ptr);
 524             /* Delete from hash table */
 525               next_fo = fo_next(curr_fo);
 526               if (prev_fo == 0) {
 527                 fo_head[i] = next_fo;
 528               } else {
 529                 fo_set_next(prev_fo, next_fo);
 530               }
 531               GC_fo_entries--;
 532             /* Add to list of objects awaiting finalization.    */
 533               fo_set_next(curr_fo, GC_finalize_now);
 534               GC_finalize_now = curr_fo;
 535 #           ifdef PRINTSTATS
 536               if (!GC_is_marked((ptr_t)curr_fo)) {
 537                 ABORT("GC_finalize: found accessible unmarked object\n");
 538               }
 539 #           endif
 540             curr_fo = next_fo;
 541         } else {
 542             prev_fo = curr_fo;
 543             curr_fo = fo_next(curr_fo);
 544         }
 545       }
 546     }
 547   /* Remove dangling disappearing links. */
 548     for (i = 0; i < dl_size; i++) {
 549       curr_dl = dl_head[i];
 550       prev_dl = 0;
 551       while (curr_dl != 0) {
 552         real_link = GC_base((ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link));
 553         if (real_link != 0 && !GC_is_marked(real_link)) {
 554             next_dl = dl_next(curr_dl);
 555             if (prev_dl == 0) {
 556                 dl_head[i] = next_dl;
 557             } else {
 558                 dl_set_next(prev_dl, next_dl);
 559             }
 560             GC_clear_mark_bit((ptr_t)curr_dl);
 561             GC_dl_entries--;
 562             curr_dl = next_dl;
 563         } else {
 564             prev_dl = curr_dl;
 565             curr_dl = dl_next(curr_dl);
 566         }
 567       }
 568     }
 569 }
 570
 571 /* Invoke finalizers for all objects that are ready to be finalized.    */
 572 /* Should be called without allocation lock.                            */
 573 void GC_invoke_finalizers()
 574 {
 575     ptr_t real_ptr;
 576     register struct finalizable_object * curr_fo;
 577     DCL_LOCK_STATE;
 578
 579     while (GC_finalize_now != 0) {
 580 #       ifdef THREADS
 581             DISABLE_SIGNALS();
 582             LOCK();
 583 #       endif
 584         curr_fo = GC_finalize_now;
 585 #       ifdef THREADS
 586             if (curr_fo != 0) GC_finalize_now = fo_next(curr_fo);
 587             UNLOCK();
 588             ENABLE_SIGNALS();
 589             if (curr_fo == 0) break;
 590 #       else
 591             GC_finalize_now = fo_next(curr_fo);
 592 #       endif
 593         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
 594         (*(curr_fo -> fo_fn))(real_ptr, curr_fo -> fo_client_data);
 595 #       ifndef THREADS
 596             GC_free((extern_ptr_t)curr_fo);
 597 #       endif
 598     }
 599 }
 600
 601 # ifdef __STDC__
 602     extern_ptr_t GC_call_with_alloc_lock(GC_fn_type fn, extern_ptr_t client_data)
 603 # else
 604     extern_ptr_t GC_call_with_alloc_lock(fn, client_data)
 605     GC_fn_type fn;
 606     extern_ptr_t client_data;
 607 # endif
 608 {
 609     extern_ptr_t result;
 610     DCL_LOCK_STATE;
 611
 612 #   ifdef THREADS
 613       DISABLE_SIGNALS();
 614       LOCK();
 615 #   endif
 616     result = (*fn)(client_data);
 617 #   ifdef THREADS
 618       UNLOCK();
 619       ENABLE_SIGNALS();
 620 #   endif
 621     return(result);
 622 }
 623