Index: /trunk/ccl/lisp-kernel/area.h =================================================================== --- /trunk/ccl/lisp-kernel/area.h (revision 604) +++ /trunk/ccl/lisp-kernel/area.h (revision 605) @@ -82,6 +82,8 @@ area *new_area(BytePtr, BytePtr, area_code); -void add_area(area *); -area *remove_area(area *); +void add_area(area *, TCR *); +void add_area_holding_area_lock(area *); +void condemn_area(area *, TCR *); +void condemn_area_holding_area_lock(area *); area *area_containing(BytePtr); area *stack_area_containing(BytePtr); Index: /trunk/ccl/lisp-kernel/gc.c =================================================================== --- /trunk/ccl/lisp-kernel/gc.c (revision 604) +++ /trunk/ccl/lisp-kernel/gc.c (revision 605) @@ -31,4 +31,5 @@ #include "gc.h" #include "area.h" +#include "Threads.h" #include #include @@ -78,6 +79,12 @@ */ -void -add_area(area *new_area) +/* + If we already own the area_lock (or during iniitalization), it's safe + to add an area. +*/ + + +void +add_area_holding_area_lock(area *new_area) { area *that = all_areas; @@ -93,4 +100,15 @@ add_area_before(new_area, that); } + +/* + In general, we need to own the area lock before adding an area. +*/ +void +add_area(area *new_area, TCR *tcr) +{ + LOCK(lisp_global(AREA_LOCK),tcr); + add_area_holding_area_lock(new_area); + LOCK(lisp_global(AREA_LOCK),tcr); +} /* @@ -684,5 +702,5 @@ void -condemn_area(area *a) +condemn_area_holding_area_lock(area *a) { void free_stack(void *); @@ -705,4 +723,11 @@ } +void +condemn_area(area *a, TCR *tcr) +{ + LOCK(lisp_global(AREA_LOCK),tcr); + condemn_area_holding_area_lock(a); + LOCK(lisp_global(AREA_LOCK),tcr); +} /* @@ -713,13 +738,17 @@ */ void -condemn_area_chain(area *a) +condemn_area_chain(area *a, TCR *tcr) { area *older; + + LOCK(lisp_global(AREA_LOCK),tcr); + for (; a->younger; a = a->younger) ; for (;a;) { older = a->older; - condemn_area(a); + condemn_area_holding_area_lock(a); a = older; } + UNLOCK(lisp_global(AREA_LOCK),tcr); } @@ -1878,5 +1907,5 @@ switch (flag) { case xmacptr_flag_recursive_lock: - destroy_recursive_lock(ptr); + destroy_recursive_lock((RECURSIVE_LOCK)ptr); break; Index: /trunk/ccl/lisp-kernel/image.c =================================================================== --- /trunk/ccl/lisp-kernel/image.c (revision 604) +++ /trunk/ccl/lisp-kernel/image.c (revision 605) @@ -711,5 +711,5 @@ make_dynamic_heap_executable(a->low, a->active); case AREA_READONLY: - add_area(a); + add_area_holding_area_lock(a); break; } Index: /trunk/ccl/lisp-kernel/imports.s =================================================================== --- /trunk/ccl/lisp-kernel/imports.s (revision 604) +++ /trunk/ccl/lisp-kernel/imports.s (revision 605) @@ -36,7 +36,7 @@ defimport(allocate) defimport(deallocate) - defimport(allocate_tstack) - defimport(allocate_vstack) - defimport(register_cstack) + defimport(allocate_tstack_holding_area_lock) + defimport(allocate_vstack_holding_area_lock) + defimport(register_cstack_holding_area_lock) defimport(condemn_area_chain) defimport(metering_control) Index: /trunk/ccl/lisp-kernel/lisp_globals.h =================================================================== --- /trunk/ccl/lisp-kernel/lisp_globals.h (revision 604) +++ /trunk/ccl/lisp-kernel/lisp_globals.h (revision 605) @@ -31,5 +31,5 @@ #define RET1VALN (-9) /* magic multiple-values return address */ #define TCR_KEY (-10) /* tsd key for per-thread tcr */ -#define bad_GC_LOCK (-11) /* rwlock for GC */ +#define AREA_LOCK (-11) /* all_areas lock */ #define EXCEPTION_LOCK (-12) /* serialize exception handling */ #define GO_TAG_COUNTER (-13) Index: /trunk/ccl/lisp-kernel/pmcl-kernel.c =================================================================== --- /trunk/ccl/lisp-kernel/pmcl-kernel.c (revision 604) +++ /trunk/ccl/lisp-kernel/pmcl-kernel.c (revision 605) @@ -177,7 +177,7 @@ } -/* This'll allocate a tstack or a vstack, but the thread - mangler won't let us allocate or reliably protect - a control stack. +/* + This should only called by something that owns the area_lock, or + by the initial thread before other threads exist. */ area * @@ -212,11 +212,14 @@ a->softprot = soft_area; a->hardprot = hard_area; - add_area(a); + add_area_holding_area_lock(a); } return a; } +/* + Also assumes ownership of the area_lock +*/ area* -register_cstack(BytePtr bottom, unsigned size) +register_cstack_holding_area_lock(BytePtr bottom, unsigned size) { BytePtr lowlimit = (BytePtr) (((((unsigned)bottom)-size)+4095)&~4095); @@ -225,10 +228,11 @@ a->hardlimit = lowlimit+CSTACK_HARDPROT; a->softlimit = a->hardlimit+CSTACK_SOFTPROT; - add_area(a); + add_area_holding_area_lock(a); return a; } + area* -allocate_vstack(unsigned usable) +allocate_vstack_holding_area_lock(unsigned usable) { return allocate_lisp_stack_area(AREA_VSTACK, @@ -242,5 +246,5 @@ area * -allocate_tstack(unsigned usable) +allocate_tstack_holding_area_lock(unsigned usable) { return allocate_lisp_stack_area(AREA_TSTACK, @@ -272,7 +276,4 @@ } } - - - @@ -644,5 +645,5 @@ a = new_area(start, end, AREA_DYNAMIC); a->active = start+initsize; - add_area(a); + add_area_holding_area_lock(a); a->markbits = reserved_area->markbits; reserved_area->markbits = NULL; @@ -1158,8 +1159,4 @@ program_name = argv[0]; if ((argc == 2) && (*argv[1] != '-')) { -#ifdef DARWIN - extern int NXArgc; - NXArgc = 1; -#endif image_name = argv[1]; argv[1] = NULL; @@ -1181,4 +1178,6 @@ create_reserved_area(reserved_area_size); set_nil(load_image(image_name)); + lisp_global(AREA_LOCK) = ptr_to_lispobj(area_lock); + lisp_global(SUBPRIMS_BASE) = (LispObj)(1<<20); lisp_global(RET1VALN) = (LispObj)&ret1valn; @@ -1226,7 +1225,7 @@ g2_area = new_area(lowptr, lowptr, AREA_STATIC); tenured_area = new_area(lowptr, lowptr, AREA_STATIC); - add_area(tenured_area); - add_area(g2_area); - add_area(g1_area); + add_area_holding_area_lock(tenured_area); + add_area_holding_area_lock(g2_area); + add_area_holding_area_lock(g1_area); g1_area->code = AREA_DYNAMIC; Index: /trunk/ccl/lisp-kernel/thread_manager.c =================================================================== --- /trunk/ccl/lisp-kernel/thread_manager.c (revision 604) +++ /trunk/ccl/lisp-kernel/thread_manager.c (revision 605) @@ -406,9 +406,14 @@ } - + +/* + Caller must hold the area_lock. +*/ TCR * new_tcr(unsigned vstack_size, unsigned tstack_size) { - extern area* allocate_vstack(unsigned), *allocate_tstack(unsigned); + extern area + *allocate_vstack_holding_area_lock(unsigned), + *allocate_tstack_holding_tcr(unsigned); area *a; TCR *tcr = calloc(1, sizeof(TCR)); @@ -420,8 +425,8 @@ tcr->reset_completion = new_semaphore(0); tcr->activate = new_semaphore(0); - a = allocate_vstack(vstack_size); + a = allocate_vstack_holding_area_lock(vstack_size); tcr->vs_area = a; tcr->save_vsp = (LispObj *) a->active; - a = allocate_tstack(tstack_size); + a = allocate_tstack_holding_area_lock(tstack_size); tcr->ts_area = a; tcr->save_tsp = (LispObj *) a->active; @@ -458,5 +463,5 @@ darwin_exception_cleanup(tcr); #endif - + LOCK(lisp_global(AREA_LOCK),tcr); vs = tcr->vs_area; tcr->vs_area = NULL; @@ -466,11 +471,11 @@ tcr->cs_area = NULL; if (vs) { - condemn_area(vs); + condemn_area_holding_area_lock(vs); } if (ts) { - condemn_area(ts); + condemn_area_holding_area_lock(ts); } if (cs) { - condemn_area(cs); + condemn_area_holding_area_lock(cs); } destroy_semaphore(&tcr->suspend); @@ -479,4 +484,5 @@ destroy_semaphore(&tcr->activate); tcr->osid = 0; + UNLOCK(lisp_global(AREA_LOCK),tcr); } else { tsd_set(lisp_global(TCR_KEY), tcr); @@ -500,9 +506,11 @@ thread_init_tcr(TCR *tcr, void *stack_base, unsigned stack_size) { - area *a, *register_cstack(BytePtr, unsigned); + area *a, *register_cstack_holding_area_lock(BytePtr, unsigned); tcr->osid = current_thread_osid(); tcr->native_thread_id = current_native_thread_id(); - a = register_cstack((BytePtr)stack_base, stack_size); + LOCK(lisp_global(AREA_LOCK),tcr); + a = register_cstack_holding_area_lock((BytePtr)stack_base, stack_size); + UNLOCK(lisp_global(AREA_LOCK),tcr); tcr->cs_area = a; if (!(tcr->flags & (1<