Example #1
0
File: table.c Project: Archs/scheme
object make_table(long capacity) {
  object bindings = make_vector(capacity*2, false_object);
  long size = sizeof(struct table_heap_structure);
  object *ve, v;
  PUSH_GC_PROTECT(bindings);
  v = make_heap_object(TABLE_TYPE,size);
  TABLE_COUNT(v) = 0;
  VECTOR_TAG(bindings) = false_object;
  /* FIX ME */
  TABLE_BINDINGS(v) = bindings;
  POP_GC_PROTECT(1);
  return v;
}
Example #2
0
File: table.c Project: Archs/scheme
static void primop_table_p(long argc) {
    if (TABLE_P(*sp) && FALSE_P(VECTOR_TAG(TABLE_BINDINGS(*sp)))) return;
    *sp = false_object;
}
Example #3
0
void garbage_collect(long min_space) {
    char *p;
    object **gcp;
    object *op;
    long i, max, count;
    int old_interrupt;
    
    if (*will_gc_hook) (*will_gc_hook)();
    old_interrupt = enable_interrupts(0);
    /* switch heap space */
    gc_count++;
    /*    printf("[GC]\n"); */
    heap += heap_size;
    if (heap >= max_heap)
	heap = min_memory;
    heap_pointer = heap;
    heap_end = heap + heap_size;
    /* migrate objects */
    count = gc_root_stack_pointer - gc_root_stack_begin;
    migrate_object(gc_root_stack_buffer);
    if (FORWARDED_P(gc_root_stack_buffer)) gc_root_stack_buffer = FORWARDED_POINTER(gc_root_stack_buffer);
    gc_root_stack_begin = (object **)BUFFER_DATA(gc_root_stack_buffer);
    gc_root_stack_end = gc_root_stack_begin + GC_ROOT_STACK_MAX;
    gc_root_stack_pointer = gc_root_stack_begin + count;
    gcp = gc_root_stack_begin;
    for (i=0; i<count; i++)
	migrate_object(*gcp[i]);
    for (op = sp; op < stack_top; op++)
	migrate_object(*op);
    /* eliminate forwarding pointers */
    gcp = gc_root_stack_begin;
    for (i=0; i<count; i++) {
	object o = *gcp[i];
	if (FORWARDED_P(o))
	    *gcp[i] = FORWARDED_POINTER(o);
    }
    for (op = sp; op < stack_top; op++) {
	object o = *op;
	if (FORWARDED_P(o))
	    *op = FORWARDED_POINTER(o);
    }
    p = heap;
    while (p < heap_pointer) {
	object *q, obj, o;
	obj = (object)p;
	switch (POINTER_TYPE(obj)) {
	case PAIR_TYPE:
	    o = CAR(obj); if (FORWARDED_P(o)) CAR(obj) = FORWARDED_POINTER(o);
	    o = CDR(obj); if (FORWARDED_P(o)) CDR(obj) = FORWARDED_POINTER(o);
	    break;
	case WEAK_TYPE:
	    if (FORWARDED_P(WEAK_VALUE(obj))) {
		WEAK_BOUND(obj) = 1;
	    } else {
		WEAK_BOUND(obj) = 0;
		migrate_object(WEAK_VALUE(obj));
	    }
	    o = WEAK_VALUE(obj); if (FORWARDED_P(o)) WEAK_VALUE(obj) = FORWARDED_POINTER(o);
	    break;
	case SYMBOL_TYPE:
	    o = SYMBOL_VALUE(obj); if (FORWARDED_P(o)) SYMBOL_VALUE(obj) = FORWARDED_POINTER(o);
	    break;
	case VECTOR_TYPE:
	    max = VECTOR_LENGTH(obj);
	    q = VECTOR_ELEMENTS(obj);
	    for (i=0; i<max; i++) {
		o = q[i]; if (FORWARDED_P(o)) q[i] = FORWARDED_POINTER(o);
	    }
	    o = VECTOR_TAG(obj); if (FORWARDED_P(o)) VECTOR_TAG(obj) = FORWARDED_POINTER(o);
	    break;
	case PROCEDURE_TYPE:
	    o = PROC_MODULE(obj); if (FORWARDED_P(o)) PROC_MODULE(obj) = FORWARDED_POINTER(o);
	    break;
	case FRAME_TYPE:
	    o = FRAME_PREVIOUS(obj); if (FORWARDED_P(o)) FRAME_PREVIOUS(obj) = FORWARDED_POINTER(o);
	    o = FRAME_ENV(obj); if (FORWARDED_P(o)) FRAME_ENV(obj) = FORWARDED_POINTER(o);
	    max = (POINTER_LENGTH(obj) - sizeof(struct frame_heap_structure))/sizeof(long);
	    q = FRAME_ELEMENTS(obj);
	    for (i=0; i<max; i++) {
		o = q[i]; if (FORWARDED_P(o)) q[i] = FORWARDED_POINTER(o);
	    }
	    break;
	case CLOSURE_TYPE:
	    o = CLOSURE_PROC(obj); if (FORWARDED_P(o)) CLOSURE_PROC(obj) = FORWARDED_POINTER(o);
	    o = CLOSURE_ENV(obj); if (FORWARDED_P(o)) CLOSURE_ENV(obj) = FORWARDED_POINTER(o);
	    break;
	case CONTINUATION_TYPE:
	    o = CONTINUATION_FRAME(obj); if (FORWARDED_P(o)) CONTINUATION_FRAME(obj) = FORWARDED_POINTER(o);
	    max = CONTINUATION_STACKSIZE(obj);
	    q = CONTINUATION_STACK(obj);
	    for (i=0; i<max; i++) {
		o = q[i]; if (FORWARDED_P(o)) q[i] = FORWARDED_POINTER(o);
	    }
	    break;
	case SYMBOLTABLE_TYPE:
	    o = SYMBOLTABLE_MAPPINGS(obj); if (FORWARDED_P(o)) SYMBOLTABLE_MAPPINGS(obj) = FORWARDED_POINTER(o);
	    break;
	case PORT_TYPE:
	    o = PORT_BUFFER(obj); if (FORWARDED_P(o)) PORT_BUFFER(obj) = FORWARDED_POINTER(o);
	    break;
    default:
        fatal_error("Unknown pointer type: heap.c#garbage_collect(): %p\n", obj);
        return;
    }
	p += POINTER_LENGTH(obj);
    }
    /* finalization of ports */
    close_stale_ports();
    fix_runtime_pointers();
    /* Finish up */
    enable_interrupts(old_interrupt);
    i = heap_size - (heap_pointer - heap);
    if (i < min_space)
	fatal_error("out of heap space: %d\n", i);
    if (*did_gc_hook) (*did_gc_hook)();
}