X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Falloc.c;h=9e978876407c30f3999f19f25267bd4f46e092a8;hb=3a340441c36832861f53fc16478607ea8ab5cb2e;hp=896467c2bcf4fa05ee79d97335afbaaf8b98fcc4;hpb=1eb303172df6650de51ad12b993a392681f50c50;p=sbcl.git diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index 896467c..9e97887 100644 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@ -24,28 +24,42 @@ #include "globals.h" #include "gc.h" #include "thread.h" +#include "pseudo-atomic.h" #include "genesis/vector.h" #include "genesis/cons.h" #include "genesis/bignum.h" #include "genesis/sap.h" +#include "genesis/code.h" #define ALIGNED_SIZE(n) ((n) + LOWTAG_MASK) & ~LOWTAG_MASK #ifdef LISP_FEATURE_GENCGC -extern lispobj *alloc(long bytes); -#endif - static lispobj * -pa_alloc(int bytes) +pa_alloc(int bytes, int page_type_flag) { lispobj *result; -#ifdef LISP_FEATURE_GENCGC struct thread *th = arch_os_get_current_thread(); +#ifndef LISP_FEATURE_SB_SAFEPOINT + /* SIG_STOP_FOR_GC must be unblocked: else two threads racing here + * may deadlock: one will wait on the GC lock, and the other + * cannot stop the first one... */ + check_gc_signals_unblocked_or_lose(0); +#endif + /* FIXME: OOAO violation: see arch_pseudo_* */ - clear_pseudo_atomic_interrupted(th); set_pseudo_atomic_atomic(th); - result = alloc(bytes); + result = general_alloc(bytes, page_type_flag); +#if 0 + /* See how the runtime deals with GC being triggerred. */ + if ((SymbolValue(GC_PENDING,th) == NIL) && + (SymbolValue(GC_INHIBIT,th) == NIL) && + (random() < RAND_MAX/100)) { + SetSymbolValue(GC_PENDING,T,th); + set_pseudo_atomic_interrupted(th); + maybe_save_gc_mask_and_block_deferrables(NULL); + } +#endif clear_pseudo_atomic_atomic(th); if (get_pseudo_atomic_interrupted(th)) { @@ -61,18 +75,28 @@ pa_alloc(int bytes) #ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD #error "!C_STACK_IS_CONTROL_STACK and STACK_GROWS_DOWNWARD_NOT_UPWARD is not supported" #endif - *current_control_stack_pointer = (lispobj) result; - current_control_stack_pointer += 1; + *access_control_stack_pointer(th) = (lispobj) result; + access_control_stack_pointer(th) += 1; #endif do_pending_interrupt(); #ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK - current_control_stack_pointer -= 1; - result = (lispobj *) *current_control_stack_pointer; + access_control_stack_pointer(th) -= 1; + result = (lispobj *) *access_control_stack_pointer(th); #endif } + return result; +} #else - /* FIXME: this is not pseudo atomic at all, but is called only from - * interrupt safe places like interrupt handlers. MG - 2005-08-09 */ +static lispobj * +pa_alloc(int bytes, int page_type_flag) +{ + lispobj *result; + + /* This is not pseudo atomic at all, but is called only from + * interrupt safe places like interrupt handlers. MG - + * 2005-08-09 */ + check_deferrables_blocked_or_lose(0); + result = dynamic_space_free_pointer; /* Align up to next dual word boundary. */ @@ -86,28 +110,29 @@ pa_alloc(int bytes) set_auto_gc_trigger((char *)dynamic_space_free_pointer - (char *)current_dynamic_space); } -#endif return result; } +#endif - -lispobj * +static lispobj * alloc_unboxed(int type, int words) { lispobj *result; - result = pa_alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj))); + result = pa_alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj)), + UNBOXED_PAGE_FLAG); *result = (lispobj) (words << N_WIDETAG_BITS) | type; return result; } static lispobj -alloc_vector(int type, int length, int size) +alloc_vector(int type, int length, int size, int page_type_flag) { struct vector *result; result = (struct vector *) - pa_alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj))); + pa_alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj)), + page_type_flag); result->header = type; result->length = make_fixnum(length); @@ -119,7 +144,8 @@ lispobj alloc_cons(lispobj car, lispobj cdr) { struct cons *ptr = - (struct cons *)pa_alloc(ALIGNED_SIZE(sizeof(struct cons))); + (struct cons *)pa_alloc(ALIGNED_SIZE(sizeof(struct cons)), + BOXED_PAGE_FLAG); ptr->car = car; ptr->cdr = cdr; @@ -147,7 +173,8 @@ lispobj alloc_base_string(char *str) { int len = strlen(str); - lispobj result = alloc_vector(SIMPLE_BASE_STRING_WIDETAG, len+1, 8); + lispobj result = alloc_vector(SIMPLE_BASE_STRING_WIDETAG, len+1, 8, + UNBOXED_PAGE_FLAG); struct vector *vec = (struct vector *)native_pointer(result); vec->length = make_fixnum(len); @@ -165,3 +192,34 @@ alloc_sap(void *ptr) sap->pointer = ptr; return make_lispobj(sap,OTHER_POINTER_LOWTAG); } + +lispobj +alloc_code_object (unsigned boxed, unsigned unboxed) { + struct code * code; + /* Coming in, boxed is the number of boxed words requested. + * Converting it to a fixnum makes it measured in bytes. It's also + * rounded up to double word along the way. */ + boxed = (boxed + 1 + + (offsetof(struct code, trace_table_offset) >> + WORD_SHIFT)) << WORD_SHIFT; + boxed &= ~LOWTAG_MASK; + + /* Unboxed is in bytes, round it up to double word boundary. Now + * it's also a fixnum containing the number of unboxed words. */ + unboxed += LOWTAG_MASK; + unboxed &= ~LOWTAG_MASK; + + code = (struct code *)pa_alloc(boxed + unboxed, CODE_PAGE_FLAG); + + /* It used to be that even on gencgc builds the + * ALLOCATE-CODE-OBJECT VOP did all this initialization within + * pseudo atomic. Here, we rely on gc being inhibited. */ + if (SymbolValue(GC_INHIBIT, arch_os_get_current_thread()) == NIL) + lose("alloc_code_object called with GC enabled."); + boxed = boxed << (N_WIDETAG_BITS - WORD_SHIFT); + code->header = boxed | CODE_HEADER_WIDETAG; + code->code_size = unboxed >> (WORD_SHIFT - N_FIXNUM_TAG_BITS); + code->entry_points = NIL; + code->debug_info = NIL; + return make_lispobj(code, OTHER_POINTER_LOWTAG); +}