-
-#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 GET_GC_TRIGGER() current_auto_gc_trigger
-#define SET_GC_TRIGGER(new_value) \
- clear_auto_gc_trigger(); set_auto_gc_trigger(new_value);
+#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
+static lispobj *
+pa_alloc(int bytes, int page_type_flag)
+{
+ lispobj *result;
+ struct thread *th = arch_os_get_current_thread();
+
+ /* 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);
+
+ /* FIXME: OOAO violation: see arch_pseudo_* */
+ set_pseudo_atomic_atomic(th);
+ 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);
+ }