static void
undo_init_new_thread(struct thread *th, init_thread_data *scribble)
{
int lock_ret;
/* Kludge: Changed the order of some steps between the safepoint/
* non-safepoint versions of this code. Can we unify this more?
*/
#ifdef LISP_FEATURE_SB_SAFEPOINT
block_blockable_signals(0);
gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
#if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->sprof_alloc_region);
#endif
pop_gcing_safety(&scribble->safety);
lock_ret = pthread_mutex_lock(&all_threads_lock);
gc_assert(lock_ret == 0);
unlink_thread(th);
lock_ret = pthread_mutex_unlock(&all_threads_lock);
gc_assert(lock_ret == 0);
#else
/* Block GC */
block_blockable_signals(0);
set_thread_state(th, STATE_DEAD);
/* SIG_STOP_FOR_GC is blocked and GC might be waiting for this
* thread, but since we are already dead it won't wait long. */
lock_ret = pthread_mutex_lock(&all_threads_lock);
gc_assert(lock_ret == 0);
gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region);
#if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32)
gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->sprof_alloc_region);
#endif
unlink_thread(th);
pthread_mutex_unlock(&all_threads_lock);
gc_assert(lock_ret == 0);
#endif
arch_os_thread_cleanup(th);
#ifndef LISP_FEATURE_SB_SAFEPOINT
os_sem_destroy(th->state_sem);
os_sem_destroy(th->state_not_running_sem);
os_sem_destroy(th->state_not_stopped_sem);
#endif
#ifdef LISP_FEATURE_MACH_EXCEPTION_HANDLER
mach_lisp_thread_destroy(th);
#endif
#if defined(LISP_FEATURE_WIN32)
int i;
for (i = 0; i<
(int) (sizeof(th->private_events.events)/
sizeof(th->private_events.events[0])); ++i) {
CloseHandle(th->private_events.events[i]);
}
TlsSetValue(OUR_TLS_INDEX,NULL);
#endif
/* Undo the association of the current pthread to its `struct thread',
* such that we can call arch_os_get_current_thread() later in this
* thread and cleanly get back NULL. */
#ifdef LISP_FEATURE_GCC_TLS
current_thread = NULL;
#else
pthread_setspecific(specials, NULL);
#endif
}
boolean
save_executable(char *filename, lispobj init_function)
{
char *dir_name;
#if defined WANT_CGC
volatile lispobj *func_ptr = &init_function;
char sbuf[128];
strcpy(sbuf, filename);
filename = sbuf;
/* Get rid of remnant stuff. This is a MUST so that
* the memory manager can get started correctly when
* we restart after this save. Purify is going to
* maybe move the args so we need to consider them volatile,
* especially if the gcc optimizer is working!!
*/
purify(NIL, NIL);
init_function = *func_ptr;
/* Set dynamic space pointer to base value so we don't write out
* MBs of just cleared heap.
*/
if(SymbolValue(X86_CGC_ACTIVE_P) != NIL)
SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_0_SPACE_START);
#endif
dir_name = dirname(strdup(filename));
printf("[Undoing binding stack... ");
fflush(stdout);
unbind_to_here((lispobj *)BINDING_STACK_START);
SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
SetSymbolValue(EVAL_STACK_TOP, 0);
printf("done]\n");
#if defined WANT_CGC && defined X86_CGC_ACTIVE_P
SetSymbolValue(X86_CGC_ACTIVE_P, T);
#endif
printf("[Saving current lisp image as executable into \"%s\":\n", filename);
printf("\t[Writing core objects\n");
fflush(stdout);
write_space_object(dir_name, READ_ONLY_SPACE_ID, (os_vm_address_t)read_only_space,
(os_vm_address_t)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
write_space_object(dir_name, STATIC_SPACE_ID, (os_vm_address_t)static_space,
(os_vm_address_t)SymbolValue(STATIC_SPACE_FREE_POINTER));
#ifdef GENCGC
/* Flush the current_region updating the tables. */
#ifdef DEBUG_BAD_HEAP
fprintf(stderr, "before ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
dump_region(&boxed_region);
#endif
gc_alloc_update_page_tables(0,&boxed_region);
gc_alloc_update_page_tables(1,&unboxed_region);
#ifdef DEBUG_BAD_HEAP
fprintf(stderr, "boxed_region after update\n");
dump_region(&boxed_region);
print_ptr((lispobj*) 0x2805a184);
#endif
#ifdef DEBUG_BAD_HEAP
/*
* For some reason x86 has a heap corruption problem. I (rtoy)
* have not been able to figure out how that occurs, but what is
* happening is that when a core is loaded, there is some static
* object pointing to an object that is on a free page. In normal
* usage, at startup there should be 4 objects in static space
* pointing to a free page, because these are newly allocated
* objects created by the C runtime. However, there is an
* additional object.
*
* I do not know what this object should be or how it got there,
* but it will often cause CMUCL to fail to save a new core file.
*
* Disabling this call to update_dynamic_space_free_pointer is a
* work around. What is happening is that u_d_s_f_p is resetting
* ALLOCATION_POINTER, but that weird object is in the current
* region, but after resetting the pointer, that object isn't
* saved to the core file. By not resetting the pointer, the
* object (or at least enough of it) gets saved in the core file
* that we don't have problems when reloading.
*
* Note that on sparc and ppc, u_d_s_f_p doesn't actually do
* anything because the call to reset ALLOCATION_POINTER is a nop
* on sparc and ppc. And sparc and ppc dont' have the heap
* corruption issue. That's not conclusive evidence, though.
*
* This needs more work and investigation.
*/
update_dynamic_space_free_pointer();
#endif
#ifdef DEBUG_BAD_HEAP
fprintf(stderr, "after ALLOC_POINTER = %p\n", (lispobj *) SymbolValue(ALLOCATION_POINTER));
#endif
#endif
#ifdef reg_ALLOC
write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
(os_vm_address_t)current_dynamic_space_free_pointer);
#else
write_space_object(dir_name, DYNAMIC_SPACE_ID, (os_vm_address_t)current_dynamic_space,
(os_vm_address_t)SymbolValue(ALLOCATION_POINTER));
#endif
printf("\tdone]\n");
fflush(stdout);
printf("Linking executable...\n");
fflush(stdout);
obj_run_linker(init_function, filename);
printf("done.\n");
exit(0);
}