/*
* If this feature is set, we are running on a stack managed by the OS,
* and no fancy delays are required for anything. Just do it.
*/
static void
schedule_thread_post_mortem(struct thread *corpse)
{
pthread_detach(pthread_self());
int result = pthread_attr_destroy(corpse->os_attr);
gc_assert(!result);
#if defined(LISP_FEATURE_WIN32)
os_invalidate_free(corpse->os_address, THREAD_STRUCT_SIZE);
#else
os_invalidate(corpse->os_address, THREAD_STRUCT_SIZE);
#endif
}
static void
final_marking_phase(mrb_state *mrb)
{
mark_context_stack(mrb, mrb->root_c);
while (mrb->gray_list) {
if (is_gray(mrb->gray_list))
gc_mark_children(mrb, mrb->gray_list);
else
mrb->gray_list = mrb->gray_list->gcnext;
}
gc_assert(mrb->gray_list == NULL);
mrb->gray_list = mrb->variable_gray_list;
mrb->variable_gray_list = NULL;
while (mrb->gray_list) {
if (is_gray(mrb->gray_list))
gc_mark_children(mrb, mrb->gray_list);
else
mrb->gray_list = mrb->gray_list->gcnext;
}
gc_assert(mrb->gray_list == NULL);
}
void dequeue_allocation (struct foreign_allocation ** queue,
struct foreign_allocation * allocation)
{
if (allocation->prev == allocation) {
gc_assert(allocation->next == allocation);
*queue = 0;
} else {
allocation->next->prev = allocation->prev;
allocation->prev->next = allocation->next;
}
allocation->next = allocation->prev = 0;
}
/* Note: scribble must be stack-allocated */
static void
init_new_thread(struct thread *th, init_thread_data *scribble, int guardp)
{
int lock_ret;
pthread_setspecific(lisp_thread, (void *)1);
if(arch_os_thread_init(th)==0) {
/* FIXME: handle error */
lose("arch_os_thread_init failed\n");
}
th->os_thread=thread_self();
if (guardp)
protect_control_stack_guard_page(1, NULL);
protect_binding_stack_guard_page(1, NULL);
protect_alien_stack_guard_page(1, NULL);
/* Since GC can only know about this thread from the all_threads
* list and we're just adding this thread to it, there is no
* danger of deadlocking even with SIG_STOP_FOR_GC blocked (which
* it is not). */
#ifdef LISP_FEATURE_SB_SAFEPOINT
*th->csp_around_foreign_call = (lispobj)scribble;
#endif
lock_ret = pthread_mutex_lock(&all_threads_lock);
gc_assert(lock_ret == 0);
link_thread(th);
lock_ret = pthread_mutex_unlock(&all_threads_lock);
gc_assert(lock_ret == 0);
/* 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
gc_state_lock();
gc_state_wait(GC_NONE);
gc_state_unlock();
push_gcing_safety(&scribble->safety);
#endif
}
static long
lutex_scan_action(lispobj *obj)
{
/* note the address of the lutex */
if(n_lutexes >= max_lutexes) {
max_lutexes *= 2;
lutex_addresses = realloc(lutex_addresses, max_lutexes * sizeof(void *));
gc_assert(lutex_addresses);
}
lutex_addresses[n_lutexes++] = obj;
return (*sizetab[widetag_of(*obj)])(obj);
}
void enqueue_sap_pointer (void * ptr)
{
gc_assert(!scanning_roots_p);
if (!maybe_live_allocations) return;
if ((lispobj*) ptr < maybe_live_allocations->start) return;
if ((lispobj*) ptr >= maybe_live_allocations->prev->end) return;
if (foreign_pointer_count >= foreign_pointer_size)
process_foreign_pointers();
foreign_pointer_vector[foreign_pointer_count].ptr
= (lispobj*) (((lispobj)ptr) & (~1UL));
foreign_pointer_count++;
}
static void
change_gen_gc_mode(mrb_state *mrb, mrb_int enable)
{
if (is_generational(mrb) && !enable) {
clear_all_old(mrb);
gc_assert(mrb->gc_state == GC_STATE_NONE);
mrb->gc_full = FALSE;
}
else if (!is_generational(mrb) && enable) {
advance_phase(mrb, GC_STATE_NONE);
mrb->majorgc_old_threshold = mrb->gc_live_after_mark/100 * DEFAULT_MAJOR_GC_INC_RATIO;
mrb->gc_full = FALSE;
}
mrb->is_generational_gc_mode = enable;
}
static void
clear_all_old(mrb_state *mrb)
{
size_t origin_mode = mrb->is_generational_gc_mode;
gc_assert(is_generational(mrb));
if (is_major_gc(mrb)) {
advance_phase(mrb, GC_STATE_NONE);
}
mrb->is_generational_gc_mode = FALSE;
prepare_incremental_sweep(mrb);
advance_phase(mrb, GC_STATE_NONE);
mrb->variable_gray_list = mrb->gray_list = NULL;
mrb->is_generational_gc_mode = origin_mode;
}
static struct thread_post_mortem *
plan_thread_post_mortem(struct thread *corpse)
{
if (corpse) {
struct thread_post_mortem *post_mortem = malloc(sizeof(struct thread_post_mortem));
gc_assert(post_mortem);
post_mortem->os_thread = corpse->os_thread;
post_mortem->os_attr = corpse->os_attr;
post_mortem->os_address = corpse->os_address;
return post_mortem;
} else {
/* FIXME: When does this happen? */
return NULL;
}
}
void
mrb_incremental_gc(mrb_state *mrb)
{
if (mrb->gc_disabled) return;
GC_INVOKE_TIME_REPORT("mrb_incremental_gc()");
GC_TIME_START;
if (is_minor_gc(mrb)) {
do {
incremental_gc(mrb, ~0);
} while (mrb->gc_state != GC_STATE_NONE);
}
else {
size_t limit = 0, result = 0;
limit = (GC_STEP_SIZE/100) * mrb->gc_step_ratio;
while (result < limit) {
result += incremental_gc(mrb, limit);
if (mrb->gc_state == GC_STATE_NONE)
break;
}
}
if (mrb->gc_state == GC_STATE_NONE) {
gc_assert(mrb->live >= mrb->gc_live_after_mark);
mrb->gc_threshold = (mrb->gc_live_after_mark/100) * mrb->gc_interval_ratio;
if (mrb->gc_threshold < GC_STEP_SIZE) {
mrb->gc_threshold = GC_STEP_SIZE;
}
if (is_major_gc(mrb)) {
mrb->majorgc_old_threshold = mrb->gc_live_after_mark/100 * DEFAULT_MAJOR_GC_INC_RATIO;
mrb->gc_full = FALSE;
}
else if (is_minor_gc(mrb)) {
if (mrb->live > mrb->majorgc_old_threshold) {
clear_all_old(mrb);
mrb->gc_full = TRUE;
}
}
}
else {
mrb->gc_threshold = mrb->live + GC_STEP_SIZE;
}
GC_TIME_STOP_AND_REPORT;
}
static struct thread_post_mortem *
plan_thread_post_mortem(struct thread *corpse)
{
if (corpse) {
struct thread_post_mortem *post_mortem = malloc(sizeof(struct thread_post_mortem));
gc_assert(post_mortem);
post_mortem->os_thread = corpse->os_thread;
post_mortem->os_attr = corpse->os_attr;
post_mortem->os_address = corpse->os_address;
#ifdef DELAY_THREAD_POST_MORTEM
post_mortem->next = NULL;
#endif
return post_mortem;
} else {
/* FIXME: When does this happen? */
return NULL;
}
}
static void
schedule_thread_post_mortem(struct thread *corpse)
{
struct thread_post_mortem *post_mortem = NULL;
if (corpse) {
post_mortem = plan_thread_post_mortem(corpse);
#ifdef CREATE_POST_MORTEM_THREAD
pthread_t thread;
int result = pthread_create(&thread, NULL, perform_thread_post_mortem, post_mortem);
gc_assert(!result);
#else
post_mortem = (struct thread_post_mortem *)
swap_lispobjs((lispobj *)(void *)&pending_thread_post_mortem,
(lispobj)post_mortem);
perform_thread_post_mortem(post_mortem);
#endif
}
}
static void
schedule_thread_post_mortem(struct thread *corpse)
{
struct thread_post_mortem *post_mortem = NULL;
if (corpse) {
post_mortem = plan_thread_post_mortem(corpse);
#ifdef DELAY_THREAD_POST_MORTEM
pthread_mutex_lock(&thread_post_mortem_lock);
/* First stick the new post mortem to the end of the queue. */
if (pending_thread_post_mortem) {
struct thread_post_mortem *next = pending_thread_post_mortem;
while (next->next) {
next = next->next;
}
next->next = post_mortem;
} else {
pending_thread_post_mortem = post_mortem;
}
/* Then, if there are enough things in the queue, clean up one
* from the head -- or increment the count, and null out the
* post_mortem we have. */
if (pending_thread_post_mortem_count > DELAY_THREAD_POST_MORTEM) {
post_mortem = pending_thread_post_mortem;
pending_thread_post_mortem = post_mortem->next;
} else {
pending_thread_post_mortem_count++;
post_mortem = NULL;
}
pthread_mutex_unlock(&thread_post_mortem_lock);
/* Finally run, the cleanup, if any. */
perform_thread_post_mortem(post_mortem);
#elif defined(CREATE_POST_MORTEM_THREAD)
gc_assert(!pthread_create(&thread, NULL, perform_thread_post_mortem, post_mortem));
#else
post_mortem = (struct thread_post_mortem *)
swap_lispobjs((lispobj *)(void *)&pending_thread_post_mortem,
(lispobj)post_mortem);
perform_thread_post_mortem(post_mortem);
#endif
}
}
void
test_add_gray_list(void)
{
mrb_state *mrb = mrb_open();
struct RBasic *obj1, *obj2;
puts("test_add_gray_list");
gc_assert(mrb->gray_list == NULL);
obj1 = mrb_basic(mrb_str_new_cstr(mrb, "test"));
add_gray_list(mrb, obj1);
gc_assert(mrb->gray_list == obj1);
gc_assert(is_gray(obj1));
obj2 = mrb_basic(mrb_str_new_cstr(mrb, "test"));
add_gray_list(mrb, obj2);
gc_assert(mrb->gray_list == obj2);
gc_assert(mrb->gray_list->gcnext == obj1);
gc_assert(is_gray(obj2));
mrb_close(mrb);
}
static void
gc_mark_children(mrb_state *mrb, struct RBasic *obj)
{
gc_assert(is_gray(obj));
paint_black(obj);
mrb->gray_list = obj->gcnext;
mrb_gc_mark(mrb, (struct RBasic*)obj->c);
switch (obj->tt) {
case MRB_TT_ICLASS:
mrb_gc_mark(mrb, (struct RBasic*)((struct RClass*)obj)->super);
break;
case MRB_TT_CLASS:
case MRB_TT_MODULE:
case MRB_TT_SCLASS:
{
struct RClass *c = (struct RClass*)obj;
mrb_gc_mark_mt(mrb, c);
mrb_gc_mark(mrb, (struct RBasic*)c->super);
}
/* fall through */
case MRB_TT_OBJECT:
case MRB_TT_DATA:
mrb_gc_mark_iv(mrb, (struct RObject*)obj);
break;
case MRB_TT_PROC:
{
struct RProc *p = (struct RProc*)obj;
mrb_gc_mark(mrb, (struct RBasic*)p->env);
mrb_gc_mark(mrb, (struct RBasic*)p->target_class);
}
break;
case MRB_TT_ENV:
{
struct REnv *e = (struct REnv*)obj;
if (e->cioff < 0) {
int i, len;
len = (int)e->flags;
for (i=0; i<len; i++) {
mrb_gc_mark_value(mrb, e->stack[i]);
}
}
}
break;
case MRB_TT_FIBER:
{
struct mrb_context *c = ((struct RFiber*)obj)->cxt;
mark_context(mrb, c);
}
break;
case MRB_TT_ARRAY:
{
struct RArray *a = (struct RArray*)obj;
size_t i, e;
for (i=0,e=a->len; i<e; i++) {
mrb_gc_mark_value(mrb, a->ptr[i]);
}
}
break;
case MRB_TT_HASH:
mrb_gc_mark_iv(mrb, (struct RObject*)obj);
mrb_gc_mark_hash(mrb, (struct RHash*)obj);
break;
case MRB_TT_STRING:
break;
case MRB_TT_RANGE:
{
struct RRange *r = (struct RRange*)obj;
if (r->edges) {
mrb_gc_mark_value(mrb, r->edges->beg);
mrb_gc_mark_value(mrb, r->edges->end);
}
}
break;
default:
break;
}
}
static void
gc_mark_children(mrb_state *mrb, struct RBasic *obj)
{
gc_assert(is_gray(obj));
paint_black(obj);
mrb->gray_list = obj->gcnext;
mrb_gc_mark(mrb, (struct RBasic*)obj->c);
switch (obj->tt) {
case MRB_TT_ICLASS:
mrb_gc_mark(mrb, (struct RBasic*)((struct RClass*)obj)->super);
break;
case MRB_TT_CLASS:
case MRB_TT_SCLASS:
case MRB_TT_MODULE:
{
struct RClass *c = (struct RClass*)obj;
mrb_gc_mark_iv(mrb, (struct RObject*)obj);
mrb_gc_mark_mt(mrb, c);
mrb_gc_mark(mrb, (struct RBasic*)c->super);
}
break;
case MRB_TT_OBJECT:
mrb_gc_mark_iv(mrb, (struct RObject*)obj);
break;
case MRB_TT_PROC:
{
struct RProc *p = (struct RProc*)obj;
mrb_gc_mark(mrb, (struct RBasic*)p->env);
mrb_gc_mark(mrb, (struct RBasic*)p->target_class);
}
break;
case MRB_TT_ENV:
{
struct REnv *e = (struct REnv *)obj;
if (e->cioff < 0) {
int i, len;
len = (int)e->flags;
for (i=0; i<len; i++) {
mrb_gc_mark_value(mrb, e->stack[i]);
}
}
}
break;
case MRB_TT_ARRAY:
{
struct RArray *a = (struct RArray*)obj;
size_t i, e;
for (i=0,e=a->len; i<e; i++) {
mrb_gc_mark_value(mrb, a->buf[i]);
}
}
break;
case MRB_TT_HASH:
mrb_gc_mark_ht(mrb, (struct RClass*)obj);
break;
case MRB_TT_STRING:
{
struct RString *s = (struct RString*)obj;
if (s->flags & MRB_STR_SHARED) {
mrb_gc_mark_value(mrb, s->aux.shared)
}
}
break;
case MRB_TT_RANGE:
{
struct RRange *r = (struct RRange*)obj;
mrb_gc_mark_value(mrb, r->edges->beg);
mrb_gc_mark_value(mrb, r->edges->end);
}
break;
case MRB_TT_REGEX:
case MRB_TT_STRUCT:
case MRB_TT_EXCEPTION:
break;
}
}
static void
gc_mark_children(mrb_state *mrb, struct RBasic *obj)
{
gc_assert(is_gray(obj));
paint_black(obj);
mrb->gray_list = obj->gcnext;
mrb_gc_mark(mrb, (struct RBasic*)obj->c);
switch (obj->tt) {
case MRB_TT_ICLASS:
mrb_gc_mark(mrb, (struct RBasic*)((struct RClass*)obj)->super);
break;
case MRB_TT_CLASS:
case MRB_TT_MODULE:
case MRB_TT_SCLASS:
{
struct RClass *c = (struct RClass*)obj;
mrb_gc_mark_mt(mrb, c);
mrb_gc_mark(mrb, (struct RBasic*)c->super);
}
/* fall through */
case MRB_TT_OBJECT:
case MRB_TT_DATA:
mrb_gc_mark_iv(mrb, (struct RObject*)obj);
break;
case MRB_TT_PROC:
{
struct RProc *p = (struct RProc*)obj;
mrb_gc_mark(mrb, (struct RBasic*)p->env);
mrb_gc_mark(mrb, (struct RBasic*)p->target_class);
}
break;
case MRB_TT_ENV:
{
struct REnv *e = (struct REnv*)obj;
if (e->cioff < 0) {
int i, len;
len = (int)e->flags;
for (i=0; i<len; i++) {
mrb_gc_mark_value(mrb, e->stack[i]);
}
}
}
break;
case MRB_TT_ARRAY:
{
struct RArray *a = (struct RArray*)obj;
size_t i, e;
for (i=0,e=a->len; i<e; i++) {
mrb_gc_mark_value(mrb, a->ptr[i]);
}
}
break;
case MRB_TT_HASH:
mrb_gc_mark_iv(mrb, (struct RObject*)obj);
mrb_gc_mark_ht(mrb, (struct RHash*)obj);
break;
case MRB_TT_STRING:
break;
case MRB_TT_RANGE:
{
struct RRange *r = (struct RRange*)obj;
mrb_gc_mark_value(mrb, r->edges->beg);
mrb_gc_mark_value(mrb, r->edges->end);
}
break;
#ifdef ENABLE_REGEXP
case MRB_TT_MATCH:
{
struct RMatch *m = (struct RMatch*)obj;
mrb_gc_mark(mrb, (struct RBasic*)m->str);
mrb_gc_mark(mrb, (struct RBasic*)m->regexp);
}
break;
case MRB_TT_REGEX:
{
struct RRegexp *r = (struct RRegexp*)obj;
mrb_gc_mark(mrb, (struct RBasic*)r->src);
}
break;
#endif
#ifdef ENABLE_STRUCT
case MRB_TT_STRUCT:
{
struct RStruct *s = (struct RStruct*)obj;
long i;
for (i=0; i<s->len; i++){
mrb_gc_mark_value(mrb, s->ptr[i]);
}
}
break;
#endif
default:
break;
}
}
void
test_mrb_field_write_barrier(void)
{
mrb_state *mrb = mrb_open();
struct RBasic *obj, *value;
puts("test_mrb_field_write_barrier");
obj = mrb_basic(mrb_ary_new(mrb));
value = mrb_basic(mrb_str_new_cstr(mrb, "value"));
paint_black(obj);
paint_partial_white(mrb,value);
puts(" in GC_STATE_MARK");
mrb->gc_state = GC_STATE_MARK;
mrb_field_write_barrier(mrb, obj, value);
gc_assert(is_gray(value));
puts(" in GC_STATE_SWEEP");
paint_partial_white(mrb,value);
mrb->gc_state = GC_STATE_SWEEP;
mrb_field_write_barrier(mrb, obj, value);
gc_assert(obj->color & mrb->current_white_part);
gc_assert(obj->color & mrb->current_white_part);
puts(" fail with black");
mrb->gc_state = GC_STATE_MARK;
paint_white(obj);
paint_partial_white(mrb,value);
mrb_field_write_barrier(mrb, obj, value);
gc_assert(obj->color & mrb->current_white_part);
puts(" fail with gray");
mrb->gc_state = GC_STATE_MARK;
paint_black(obj);
paint_gray(value);
mrb_field_write_barrier(mrb, obj, value);
gc_assert(is_gray(value));
{
puts("test_mrb_field_write_barrier_value");
obj = mrb_basic(mrb_ary_new(mrb));
mrb_value value = mrb_str_new_cstr(mrb, "value");
paint_black(obj);
paint_partial_white(mrb, mrb_basic(value));
mrb->gc_state = GC_STATE_MARK;
mrb_field_write_barrier_value(mrb, obj, value);
gc_assert(is_gray(mrb_basic(value)));
}
mrb_close(mrb);
}
boolean
save_to_filehandle(FILE *file, char *filename, lispobj init_function,
boolean make_executable,
boolean save_runtime_options,
int core_compression_level)
{
struct thread *th;
os_vm_offset_t core_start_pos;
#ifdef LISP_FEATURE_X86_64
untune_asm_routines_for_microarch();
#endif
/* Smash the enclosing state. (Once we do this, there's no good
* way to go back, which is a sufficient reason that this ends up
* being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
printf("[undoing binding stack and other enclosing state... ");
fflush(stdout);
for_each_thread(th) { /* XXX really? */
unbind_to_here((lispobj *)th->binding_stack_start,th);
SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
}
printf("done]\n");
fflush(stdout);
/* (Now we can actually start copying ourselves into the output file.) */
printf("[saving current Lisp image into %s:\n", filename);
fflush(stdout);
core_start_pos = ftell(file);
write_lispobj(CORE_MAGIC, file);
write_lispobj(BUILD_ID_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(/* (We're writing the word count of the entry here, and the 2
* term is one word for the leading BUILD_ID_CORE_ENTRY_TYPE_CODE
* word and one word where we store the count itself.) */
2 + strlen((const char *)build_id),
file);
{
unsigned char *p;
for (p = (unsigned char *)build_id; *p; ++p)
write_lispobj(*p, file);
}
write_lispobj(NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(/* (word count = N spaces described by 5 words each, plus the
* entry type code, plus this count itself) */
(5*N_SPACES_TO_SAVE)+2, file);
output_space(file,
READ_ONLY_CORE_SPACE_ID,
(lispobj *)READ_ONLY_SPACE_START,
(lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0),
core_start_pos,
core_compression_level);
output_space(file,
STATIC_CORE_SPACE_ID,
(lispobj *)STATIC_SPACE_START,
(lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
core_start_pos,
core_compression_level);
#ifdef LISP_FEATURE_GENCGC
/* Flush the current_region, updating the tables. */
gc_alloc_update_all_page_tables(1);
update_dynamic_space_free_pointer();
#endif
#ifdef LISP_FEATURE_IMMOBILE_SPACE
prepare_immobile_space_for_save();
output_space(file,
IMMOBILE_FIXEDOBJ_CORE_SPACE_ID,
(lispobj *)IMMOBILE_SPACE_START,
(lispobj *)SymbolValue(IMMOBILE_FIXEDOBJ_FREE_POINTER,0),
core_start_pos,
core_compression_level);
output_space(file,
IMMOBILE_VARYOBJ_CORE_SPACE_ID,
(lispobj *)IMMOBILE_VARYOBJ_SUBSPACE_START,
(lispobj *)SymbolValue(IMMOBILE_SPACE_FREE_POINTER,0),
core_start_pos,
core_compression_level);
#endif
#ifdef reg_ALLOC
#ifdef LISP_FEATURE_GENCGC
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)DYNAMIC_SPACE_START,
dynamic_space_free_pointer,
core_start_pos,
core_compression_level);
#else
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)current_dynamic_space,
dynamic_space_free_pointer,
core_start_pos,
core_compression_level);
#endif
#else
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)DYNAMIC_SPACE_START,
(lispobj *)SymbolValue(ALLOCATION_POINTER,0),
core_start_pos,
core_compression_level);
#endif
write_lispobj(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(3, file);
write_lispobj(init_function, file);
#ifdef LISP_FEATURE_GENCGC
{
size_t size = (last_free_page*sizeof(sword_t)+os_vm_page_size-1)
&~(os_vm_page_size-1);
uword_t *data = calloc(size, 1);
if (data) {
uword_t word;
sword_t offset;
page_index_t i;
for (i = 0; i < last_free_page; i++) {
/* Thanks to alignment requirements, the two low bits
* are always zero, so we can use them to store the
* allocation type -- region is always closed, so only
* the two low bits of allocation flags matter. */
word = page_table[i].scan_start_offset;
gc_assert((word & 0x03) == 0);
data[i] = word | (0x03 & page_table[i].allocated);
}
write_lispobj(PAGE_TABLE_CORE_ENTRY_TYPE_CODE, file);
write_lispobj(4, file);
write_lispobj(size, file);
offset = write_bytes(file, (char *)data, size, core_start_pos);
write_lispobj(offset, file);
}
}
#endif
write_lispobj(END_CORE_ENTRY_TYPE_CODE, file);
/* Write a trailing header, ignored when parsing the core normally.
* This is used to locate the start of the core when the runtime is
* prepended to it. */
fseek(file, 0, SEEK_END);
/* If NULL runtime options are passed to write_runtime_options,
* command-line processing is performed as normal in the SBCL
* executable. Otherwise, the saved runtime options are used and
* all command-line arguments are available to Lisp in
* SB-EXT:*POSIX-ARGV*. */
write_runtime_options(file,
(save_runtime_options ? runtime_options : NULL));
if (1 != fwrite(&core_start_pos, sizeof(os_vm_offset_t), 1, file)) {
perror("Error writing core starting position to file");
fclose(file);
} else {
write_lispobj(CORE_MAGIC, file);
fclose(file);
}
#ifndef LISP_FEATURE_WIN32
if (make_executable)
chmod (filename, 0755);
#endif
printf("done]\n");
exit(0);
}
void
test_incremental_gc(void)
{
mrb_state *mrb = mrb_open();
size_t max = ~0, live = 0, total = 0, freed = 0;
RVALUE *free;
struct heap_page *page;
puts("test_incremental_gc");
change_gen_gc_mode(mrb, FALSE);
puts(" in mrb_garbage_collect");
mrb_garbage_collect(mrb);
gc_assert(mrb->gc_state == GC_STATE_NONE);
puts(" in GC_STATE_NONE");
incremental_gc(mrb, max);
gc_assert(mrb->gc_state == GC_STATE_MARK);
puts(" in GC_STATE_MARK");
advance_phase(mrb, GC_STATE_SWEEP);
gc_assert(mrb->gc_state == GC_STATE_SWEEP);
puts(" in GC_STATE_SWEEP");
page = mrb->heaps;
while (page) {
RVALUE *p = page->objects;
RVALUE *e = p + MRB_HEAP_PAGE_SIZE;
while (p<e) {
if (is_black(&p->as.basic)) {
live++;
}
if (is_gray(&p->as.basic) && !is_dead(mrb, &p->as.basic)) {
printf("%p\n", &p->as.basic);
}
p++;
}
page = page->next;
total += MRB_HEAP_PAGE_SIZE;
}
gc_assert(mrb->gray_list == NULL);
incremental_gc(mrb, max);
gc_assert(mrb->gc_state == GC_STATE_SWEEP);
incremental_gc(mrb, max);
gc_assert(mrb->gc_state == GC_STATE_NONE);
free = (RVALUE*)mrb->heaps->freelist;
while (free) {
freed++;
free = (RVALUE*)free->as.free.next;
}
gc_assert(mrb->live == live);
gc_assert(mrb->live == total-freed);
puts("test_incremental_gc(gen)");
advance_phase(mrb, GC_STATE_SWEEP);
change_gen_gc_mode(mrb, TRUE);
gc_assert(mrb->gc_full == FALSE);
gc_assert(mrb->gc_state == GC_STATE_NONE);
puts(" in minor");
gc_assert(is_minor_gc(mrb));
gc_assert(mrb->majorgc_old_threshold > 0);
mrb->majorgc_old_threshold = 0;
mrb_incremental_gc(mrb);
gc_assert(mrb->gc_full == TRUE);
gc_assert(mrb->gc_state == GC_STATE_NONE);
puts(" in major");
gc_assert(is_major_gc(mrb));
do {
mrb_incremental_gc(mrb);
} while (mrb->gc_state != GC_STATE_NONE);
gc_assert(mrb->gc_full == FALSE);
mrb_close(mrb);
}
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
}
void retire_always_live_allocation (struct foreign_allocation * allocation)
{
gc_assert(-1 == allocation->state);
dequeue_allocation(&always_live_allocations, allocation);
}
