X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc-common.c;h=0da8a1f39dd25ab191e8f2ae2d2b686fc8f3b3c5;hb=4f9b5cd4268d3e28ac54748c4871e07f38acfd4c;hp=7eb89aec6b6fd5c95d8f9c831fdad1bad294dcfe;hpb=1eb303172df6650de51ad12b993a392681f50c50;p=sbcl.git diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index 7eb89ae..0da8a1f 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -96,10 +96,9 @@ unsigned long bytes_consed_between_gcs = 12*1024*1024; /* * copying objects */ - -/* to copy a boxed object */ +static lispobj -copy_object(lispobj object, long nwords) +gc_general_copy_object(lispobj object, long nwords, int page_type_flag) { int tag; lispobj *new; @@ -112,13 +111,26 @@ copy_object(lispobj object, long nwords) tag = lowtag_of(object); /* Allocate space. */ - new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK); + new = gc_general_alloc(nwords*N_WORD_BYTES, page_type_flag, ALLOC_QUICK); /* Copy the object. */ memcpy(new,native_pointer(object),nwords*N_WORD_BYTES); return make_lispobj(new,tag); } +/* to copy a boxed object */ +lispobj +copy_object(lispobj object, long nwords) +{ + return gc_general_copy_object(object, nwords, BOXED_PAGE_FLAG); +} + +lispobj +copy_code_object(lispobj object, long nwords) +{ + return gc_general_copy_object(object, nwords, CODE_PAGE_FLAG); +} + static long scav_lose(lispobj *where, lispobj object); /* forward decl */ /* FIXME: Most calls end up going to some trouble to compute an @@ -268,7 +280,7 @@ trans_code(struct code *code) nwords = ncode_words + nheader_words; nwords = CEILING(nwords, 2); - l_new_code = copy_object(l_code, nwords); + l_new_code = copy_code_object(l_code, nwords); new_code = (struct code *) native_pointer(l_new_code); #if defined(DEBUG_CODE_GC) @@ -552,7 +564,7 @@ trans_list(lispobj object) /* Copy 'object'. */ new_cons = (struct cons *) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + gc_general_alloc(sizeof(struct cons), BOXED_PAGE_FLAG, ALLOC_QUICK); new_cons->car = cons->car; new_cons->cdr = cons->cdr; /* updated later */ new_list_pointer = make_lispobj(new_cons,lowtag_of(object)); @@ -577,7 +589,7 @@ trans_list(lispobj object) /* Copy 'cdr'. */ new_cdr_cons = (struct cons*) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + gc_general_alloc(sizeof(struct cons), BOXED_PAGE_FLAG, ALLOC_QUICK); new_cdr_cons->car = cdr_cons->car; new_cdr_cons->cdr = cdr_cons->cdr; new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr)); @@ -1873,7 +1885,7 @@ scav_lose(lispobj *where, lispobj object) { lose("no scavenge function for object 0x%08x (widetag 0x%x)\n", (unsigned long)object, - widetag_of(*(lispobj*)native_pointer(object))); + widetag_of(object)); return 0; /* bogus return value to satisfy static type checking */ } @@ -2394,9 +2406,8 @@ gc_search_space(lispobj *start, size_t words, lispobj *pointer) boolean maybe_gc(os_context_t *context) { -#ifndef LISP_FEATURE_WIN32 + lispobj gc_happened; struct thread *thread = arch_os_get_current_thread(); -#endif fake_foreign_function_call(context); /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in @@ -2422,32 +2433,37 @@ maybe_gc(os_context_t *context) * outer context. */ #ifndef LISP_FEATURE_WIN32 - if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) { - sigset_t *context_sigmask = os_context_sigmask_addr(context); -#ifdef LISP_FEATURE_SB_THREAD - /* What if the context we'd like to restore has GC signals - * blocked? Just skip the GC: we can't set GC_PENDING, because - * that would block the next attempt, and we don't know when - * we'd next check for it -- and it's hard to be sure that - * unblocking would be safe. - * - * FIXME: This is not actually much better: we may already have - * GC_PENDING set, and presumably our caller assumes that we will - * clear it. Perhaps we should, even though we don't actually GC? */ - if (sigismember(context_sigmask,SIG_STOP_FOR_GC)) { - undo_fake_foreign_function_call(context); - return 1; - } -#endif - thread_sigmask(SIG_SETMASK, context_sigmask, 0); + check_gc_signals_unblocked_in_sigset_or_lose + (os_context_sigmask_addr(context)); + unblock_gc_signals(); +#endif + FSHOW((stderr, "/maybe_gc: calling SUB_GC\n")); + /* FIXME: Nothing must go wrong during GC else we end up running + * the debugger, error handlers, and user code in general in a + * potentially unsafe place. With deferrables blocked due to + * fake_foreign_function_call + unblock_gc_signals(), we'll not + * have a pleasant time either. Running out of the control stack + * or the heap in SUB-GC are ways to lose. Of course, deferrables + * cannot be unblocked because there may be a pending handler, or + * we may even be in a WITHOUT-INTERRUPTS. */ + gc_happened = funcall0(StaticSymbolFunction(SUB_GC)); + FSHOW((stderr, "/maybe_gc: gc_happened=%s\n", + (gc_happened == NIL) ? "NIL" : "T")); + if ((gc_happened != NIL) && + /* See if interrupts are enabled or it's possible to enable + * them. POST-GC has a similar check, but we don't want to + * unlock deferrables in that case, because if there is a + * pending interrupt we'd lose, but more to point the POST-GC + * runs user code in a pretty much arbitrary place so it + * better not be in WITHOUT-INTERRUPTS. */ + ((SymbolValue(INTERRUPTS_ENABLED,thread) != NIL) || + (SymbolValue(ALLOW_WITH_INTERRUPTS,thread) != NIL))) { + FSHOW((stderr, "/maybe_gc: calling POST_GC\n")); + if (!interrupt_handler_pending_p()) + unblock_deferrable_signals(); + funcall0(StaticSymbolFunction(POST_GC)); } - else - unblock_gc_signals(); -#endif - /* SIG_STOP_FOR_GC needs to be enabled before we can call lisp: - * otherwise two threads racing here may deadlock: the other will - * wait on the GC lock, and the other cannot stop the first one... */ - funcall0(StaticSymbolFunction(SUB_GC)); undo_fake_foreign_function_call(context); - return 1; + FSHOW((stderr, "/maybe_gc: returning\n")); + return (gc_happened != NIL); }