X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Falloc.c;h=ed6ec54e77ce86c823c9aec6b3b449767fc1c6f0;hb=c3699db2053ff3b5ac6a98d4431c3789496002d8;hp=d11c82044c917b1a57a298d017bfb2b708269923;hpb=3358092524adbaecaa483d6510fb3d7031441ccb;p=sbcl.git diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c index d11c820..ed6ec54 100644 --- a/src/runtime/alloc.c +++ b/src/runtime/alloc.c @@ -1,5 +1,6 @@ /* - * allocation routines + * allocation routines for C code. For allocation done by Lisp look + * instead at src/compiler/target/alloc.lisp and .../macros.lisp */ /* @@ -13,109 +14,129 @@ * files for more information. */ -/* - * $Header$ - */ +#include +#include +#include "genesis/config.h" #include "runtime.h" +#include "os.h" #include "sbcl.h" #include "alloc.h" #include "globals.h" #include "gc.h" +#include "thread.h" +#include "genesis/vector.h" +#include "genesis/cons.h" +#include "genesis/bignum.h" +#include "genesis/sap.h" -#ifdef ibmrt -#define GET_FREE_POINTER() ((lispobj *)SymbolValue(ALLOCATION_POINTER)) -#define SET_FREE_POINTER(new_value) \ - (SetSymbolValue(ALLOCATION_POINTER,(lispobj)(new_value))) -#define GET_GC_TRIGGER() ((lispobj *)SymbolValue(INTERNAL_GC_TRIGGER)) -#define SET_GC_TRIGGER(new_value) \ - (SetSymbolValue(INTERNAL_GC_TRIGGER,(lispobj)(new_value))) -#else #define GET_FREE_POINTER() dynamic_space_free_pointer -#define SET_FREE_POINTER(new_value) (dynamic_space_free_pointer = (new_value)) +#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); -#endif -#define ALIGNED_SIZE(n) (n+lowtag_Mask) & ~lowtag_Mask +#define ALIGNED_SIZE(n) (n+LOWTAG_MASK) & ~LOWTAG_MASK -#if defined(WANT_CGC) || defined(GENCGC) +#if defined LISP_FEATURE_GENCGC extern lispobj *alloc(int bytes); +lispobj * +pa_alloc(int bytes) +{ + lispobj *result=0; + struct thread *th=arch_os_get_current_thread(); + 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; +} + #else -static lispobj *alloc(int bytes) +static lispobj * +pa_alloc(int bytes) { - lispobj *result; + char *result; /* Round to dual word boundary. */ - bytes = (bytes + lowtag_Mask) & ~lowtag_Mask; + bytes = (bytes + LOWTAG_MASK) & ~LOWTAG_MASK; + + result = (char *)GET_FREE_POINTER(); - result = GET_FREE_POINTER(); - SET_FREE_POINTER(result + (bytes / sizeof(lispobj))); + SET_FREE_POINTER((lispobj *)(result + bytes)); if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) { SET_GC_TRIGGER((char *)GET_FREE_POINTER() - - (char *)DYNAMIC_SPACE_START); + - (char *)current_dynamic_space); } - - return result; + return (lispobj *) result; } #endif -static lispobj *alloc_unboxed(int type, int words) + +lispobj * +alloc_unboxed(int type, int words) { lispobj *result; - result = alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj))); - - *result = (lispobj) (words << type_Bits) | type; - + result = pa_alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj))); + *result = (lispobj) (words << N_WIDETAG_BITS) | type; return result; } -static lispobj alloc_vector(int type, int length, int size) +static lispobj +alloc_vector(int type, int length, int size) { struct vector *result; result = (struct vector *) - alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj))); + pa_alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj))); result->header = type; result->length = make_fixnum(length); - return ((lispobj)result)|type_OtherPointer; + return make_lispobj(result,OTHER_POINTER_LOWTAG); } -lispobj alloc_cons(lispobj car, lispobj cdr) +lispobj +alloc_cons(lispobj car, lispobj cdr) { - struct cons *ptr = (struct cons *)alloc(ALIGNED_SIZE(sizeof(struct cons))); + struct cons *ptr = (struct cons *)pa_alloc(ALIGNED_SIZE(sizeof(struct cons))); ptr->car = car; ptr->cdr = cdr; - return (lispobj)ptr | type_ListPointer; + return make_lispobj(ptr, LIST_POINTER_LOWTAG); } -lispobj alloc_number(long n) +lispobj +alloc_number(long n) { struct bignum *ptr; if (-0x20000000 < n && n < 0x20000000) return make_fixnum(n); else { - ptr = (struct bignum *)alloc_unboxed(type_Bignum, 1); + ptr = (struct bignum *)alloc_unboxed(BIGNUM_WIDETAG, 1); ptr->digits[0] = n; - return (lispobj) ptr | type_OtherPointer; + return make_lispobj(ptr, OTHER_POINTER_LOWTAG); } } -lispobj alloc_string(char *str) +lispobj +alloc_base_string(char *str) { int len = strlen(str); - lispobj result = alloc_vector(type_SimpleString, len+1, 8); - struct vector *vec = (struct vector *)PTR(result); + lispobj result = alloc_vector(SIMPLE_BASE_STRING_WIDETAG, len+1, 8); + struct vector *vec = (struct vector *)native_pointer(result); vec->length = make_fixnum(len); strcpy((char *)vec->data, str); @@ -123,18 +144,12 @@ lispobj alloc_string(char *str) return result; } -lispobj alloc_sap(void *ptr) +lispobj +alloc_sap(void *ptr) { - /* FIXME: It would probably be good to grep for "alpha" everywhere - * and replace this kind of weirdness with nicer parameterizations - * like N_WORDS_IN_POINTER. However, it might be hard to do this - * well enough to be useful without an Alpha to test on. What to do? */ -#ifndef alpha - struct sap *sap = (struct sap *)alloc_unboxed(type_Sap, 1); -#else - struct sap *sap = (struct sap *)alloc_unboxed(type_Sap, 3); -#endif + struct sap *sap; + sap=(struct sap *) + alloc_unboxed((int)SAP_WIDETAG, sizeof(struct sap)/sizeof(lispobj) -1); sap->pointer = ptr; - - return (lispobj) sap | type_OtherPointer; + return make_lispobj(sap,OTHER_POINTER_LOWTAG); }