X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Falloc.c;h=be7998cc3cd0b21122b6dfa6797748d94c9a266a;hb=70227794f1eefb567c13ec04f7bd6d3b6794aa29;hp=9fcafd32fa1dc150556e88e644ee6aa0878e4d10;hpb=a7c2f2622f1ceeeb3459cb6bbcf261bda1ff2327;p=sbcl.git diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index 9fcafd3..be7998c 100644 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@ -1,5 +1,5 @@ /* - * allocation routines for C code. For allocation done by Lisp look + * allocation routines for C code. For allocation done by Lisp look * instead at src/compiler/target/alloc.lisp and .../macros.lisp */ @@ -18,7 +18,6 @@ #include #include "sbcl.h" -#include "genesis/config.h" #include "runtime.h" #include "os.h" #include "alloc.h" @@ -30,35 +29,39 @@ #include "genesis/bignum.h" #include "genesis/sap.h" -#define GET_FREE_POINTER() dynamic_space_free_pointer -#define SET_FREE_POINTER(new_value) \ - (dynamic_space_free_pointer = (new_value)) -#define GET_GC_TRIGGER() current_auto_gc_trigger -#define SET_GC_TRIGGER(new_value) \ - clear_auto_gc_trigger(); set_auto_gc_trigger(new_value); - #define ALIGNED_SIZE(n) (n+LOWTAG_MASK) & ~LOWTAG_MASK #if defined LISP_FEATURE_GENCGC extern lispobj *alloc(int bytes); lispobj * -pa_alloc(int bytes) +pa_alloc(int bytes) { lispobj *result=0; struct thread *th=arch_os_get_current_thread(); + /* FIXME: OOAO violation: see arch_pseudo_* */ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),th); SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1),th); result=alloc(bytes); SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0),th); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th)) - /* even if we gc at this point, the new allocation will be - * protected from being moved, because result is on the c stack - * and points to it */ - do_pending_interrupt(); - return result; + if (fixnum_value(SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th))) + /* even if we gc at this point, the new allocation will be + * protected from being moved, because result is on the c stack + * and points to it */ + do_pending_interrupt(); + return result; } #else + +#define GET_FREE_POINTER() dynamic_space_free_pointer +#define SET_FREE_POINTER(new_value) \ + (dynamic_space_free_pointer = (new_value)) +#define GET_GC_TRIGGER() current_auto_gc_trigger +#define SET_GC_TRIGGER(new_value) \ + clear_auto_gc_trigger(); set_auto_gc_trigger(new_value); + +/* 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) { @@ -72,8 +75,8 @@ pa_alloc(int bytes) SET_FREE_POINTER((lispobj *)(result + bytes)); if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) { - SET_GC_TRIGGER((char *)GET_FREE_POINTER() - - (char *)current_dynamic_space); + SET_GC_TRIGGER((char *)GET_FREE_POINTER() + - (char *)current_dynamic_space); } return (lispobj *) result; } @@ -127,7 +130,7 @@ alloc_number(long n) ptr->digits[0] = n; - return make_lispobj(ptr, OTHER_POINTER_LOWTAG); + return make_lispobj(ptr, OTHER_POINTER_LOWTAG); } } @@ -149,7 +152,7 @@ alloc_sap(void *ptr) { struct sap *sap; sap=(struct sap *) - alloc_unboxed((int)SAP_WIDETAG, sizeof(struct sap)/sizeof(lispobj) -1); + alloc_unboxed((int)SAP_WIDETAG, sizeof(struct sap)/sizeof(lispobj) -1); sap->pointer = ptr; return make_lispobj(sap,OTHER_POINTER_LOWTAG); }