vm: simpler and more efficient code heap compaction; restructure a few things to...

diff --git a/vm/callstack.hpp b/vm/callstack.hpp
index 27bf7dda7ad52aff17fca2d66165c116c371e321..4d449042816e03f9e2b3609c5232677a7a46f76c 100755 (executable)
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -23,8 +23,11 @@ template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *
        }
 }
 
-template<typename Iterator> void factor_vm::iterate_callstack(cell top, cell bottom, Iterator &iterator)
+template<typename Iterator> void factor_vm::iterate_callstack(context *ctx, Iterator &iterator)
 {
+       cell top = (cell)ctx->callstack_top;
+       cell bottom = (cell)ctx->callstack_bottom;
+
        stack_frame *frame = (stack_frame *)bottom - 1;
 
        while((cell)frame >= top)

diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index 7b38a5f6d37f65654b0ba367c655b9b12fd14e63..8099d09e2d7c233ea8f68cd8cf69c79aca3bc06e 100755 (executable)
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -444,7 +444,7 @@ code_block *factor_vm::allot_code_block(cell size, cell type)
        /* If allocation failed, do a code GC */
        if(block == NULL)
        {
-               gc();
+               primitive_full_gc();
                block = code->heap_allot(size + sizeof(code_block),type);
 
                /* Insufficient room even after code GC, give up */

diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index da4f7995b85e12a827b8e5ba91a66b8251618e8b..18f089f0fadbb5b80b5d999969e3c05d3ec0f67f 100755 (executable)
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -137,22 +137,24 @@ void factor_vm::primitive_code_room()
        dpush(tag_fixnum(max_free / 1024));
 }
 
-code_block *factor_vm::forward_xt(code_block *compiled)
+code_block *code_heap::forward_code_block(code_block *compiled)
 {
-       return (code_block *)code->forwarding[compiled];
+       return (code_block *)forwarding[compiled];
 }
 
-struct xt_forwarder {
+struct callframe_forwarder {
        factor_vm *myvm;
 
-       explicit xt_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
+       explicit callframe_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
 
        void operator()(stack_frame *frame)
        {
-               cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)myvm->frame_code(frame);
-               code_block *forwarded = myvm->forward_xt(myvm->frame_code(frame));
+               cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)frame->xt;
+
+               code_block *forwarded = myvm->code->forward_code_block(myvm->frame_code(frame));
                frame->xt = forwarded->xt();
-               FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)forwarded + offset);
+
+               FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)frame->xt + offset);
        }
 };
 
@@ -171,9 +173,11 @@ void factor_vm::forward_object_xts()
                                word *w = untag<word>(obj);
 
                                if(w->code)
-                                       w->code = forward_xt(w->code);
+                                       w->code = code->forward_code_block(w->code);
                                if(w->profiling)
-                                       w->profiling = forward_xt(w->profiling);
+                                       w->profiling = code->forward_code_block(w->profiling);
+
+                               update_word_xt(obj);
                        }
                        break;
                case QUOTATION_TYPE:
@@ -181,13 +185,16 @@ void factor_vm::forward_object_xts()
                                quotation *quot = untag<quotation>(obj);
 
                                if(quot->code)
-                                       quot->code = forward_xt(quot->code);
+                               {
+                                       quot->code = code->forward_code_block(quot->code);
+                                       set_quot_xt(quot,quot->code);
+                               }
                        }
                        break;
                case CALLSTACK_TYPE:
                        {
                                callstack *stack = untag<callstack>(obj);
-                               xt_forwarder forwarder(this);
+                               callframe_forwarder forwarder(this);
                                iterate_callstack_object(stack,forwarder);
                        }
                        break;
@@ -199,59 +206,26 @@ void factor_vm::forward_object_xts()
        end_scan();
 }
 
-/* Set the XT fields now that the heap has been compacted */
-void factor_vm::fixup_object_xts()
+void factor_vm::forward_context_xts()
 {
-       begin_scan();
-
-       cell obj;
+       context *ctx = stack_chain;
 
-       while((obj = next_object()) != F)
+       while(ctx)
        {
-               switch(tagged<object>(obj).type())
-               {
-               case WORD_TYPE:
-                       update_word_xt(obj);
-                       break;
-               case QUOTATION_TYPE:
-                       {
-                               quotation *quot = untag<quotation>(obj);
-                               if(quot->code)
-                                       set_quot_xt(quot,quot->code);
-                               break;
-                       }
-               default:
-                       break;
-               }
+               callframe_forwarder forwarder(this);
+               iterate_callstack(ctx,forwarder);
+               ctx = ctx->next;
        }
-
-       end_scan();
 }
 
-/* Move all free space to the end of the code heap. This is not very efficient,
-since it makes several passes over the code and data heaps, but we only ever
-do this before saving a deployed image and exiting, so performance is not
-critical here */
-void factor_vm::compact_code_heap()
+/* Move all free space to the end of the code heap. Live blocks must be marked
+on entry to this function. XTs in code blocks must be updated after this
+function returns. */
+void factor_vm::compact_code_heap(bool trace_contexts_p)
 {
-       /* Free all unreachable code blocks, don't trace contexts */
-       garbage_collection(collect_full_op,false,0);
-
-       /* Figure out where the code heap blocks are going to end up */
-       cell size = code->compute_heap_forwarding();
-
-       /* Update word and quotation code pointers */
-       forward_object_xts();
-
-       /* Actually perform the compaction */
        code->compact_heap();
-
-       /* Update word and quotation XTs */
-       fixup_object_xts();
-
-       /* Now update the free list; there will be a single free block at
-       the end */
-       code->build_free_list(size);
+       forward_object_xts();
+       if(trace_contexts_p) forward_context_xts();
 }
 
 struct stack_trace_stripper {

diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index 2f209d3e76058811e3e435a5bef9dc7a207970d3..0a96a0b27b17521fb676a6160bab2a415728a934 100755 (executable)
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -16,6 +16,7 @@ struct code_heap : heap {
        void clear_remembered_set();
        bool needs_fixup_p(code_block *compiled);
        void code_heap_free(code_block *compiled);
+       code_block *forward_code_block(code_block *compiled);
 };
 
 }

diff --git a/vm/collector.hpp b/vm/collector.hpp
index 24bba5d0a4607663fdc4ebf79f910cc910e30c2e..c70c5073e22c814ab33dd3b01f8277ca8bdc000b 100644 (file)
--- a/vm/collector.hpp
+++ b/vm/collector.hpp
@@ -132,17 +132,17 @@ template<typename TargetGeneration, typename Policy> struct collector {
 
        void trace_contexts()
        {
-               context *stacks = myvm->stack_chain;
+               context *ctx = myvm->stack_chain;
 
-               while(stacks)
+               while(ctx)
                {
-                       trace_stack_elements(stacks->datastack_region,(cell *)stacks->datastack);
-                       trace_stack_elements(stacks->retainstack_region,(cell *)stacks->retainstack);
+                       trace_stack_elements(ctx->datastack_region,(cell *)ctx->datastack);
+                       trace_stack_elements(ctx->retainstack_region,(cell *)ctx->retainstack);
 
-                       trace_handle(&stacks->catchstack_save);
-                       trace_handle(&stacks->current_callback_save);
+                       trace_handle(&ctx->catchstack_save);
+                       trace_handle(&ctx->current_callback_save);
 
-                       stacks = stacks->next;
+                       ctx = ctx->next;
                }
        }
 };

diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index 53904937dcb4f964787785239b3e8ff5d2ecea6f..7e0a2e195d8e5a4d45199bf4d2f5998ba1b7abbc 100644 (file)
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -104,9 +104,9 @@ void factor_vm::unnest_stacks()
        userenv[CURRENT_CALLBACK_ENV] = stack_chain->current_callback_save;
        userenv[CATCHSTACK_ENV] = stack_chain->catchstack_save;
 
-       context *old_stacks = stack_chain;
-       stack_chain = old_stacks->next;
-       dealloc_context(old_stacks);
+       context *old_ctx = stack_chain;
+       stack_chain = old_ctx->next;
+       dealloc_context(old_ctx);
 }
 
 void unnest_stacks(factor_vm *myvm)

diff --git a/vm/debug.cpp b/vm/debug.cpp
index 1d2edbbf46ef5a6208f4c9cec524a982ca1fcc73..0f8c310e0678c08525b18784aa4834d74f5a5e23 100755 (executable)
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@@ -189,10 +189,8 @@ struct stack_frame_printer {
 void factor_vm::print_callstack()
 {
        print_string("==== CALL STACK:\n");
-       cell bottom = (cell)stack_chain->callstack_bottom;
-       cell top = (cell)stack_chain->callstack_top;
        stack_frame_printer printer(this);
-       iterate_callstack(top,bottom,printer);
+       iterate_callstack(stack_chain,printer);
 }
 
 void factor_vm::dump_cell(cell x)
@@ -234,7 +232,7 @@ void factor_vm::dump_generations()
 
 void factor_vm::dump_objects(cell type)
 {
-       gc();
+       primitive_full_gc();
        begin_scan();
 
        cell obj;

diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp
index 8fb4eea406557bf32710d3836cf50f89301d3ef6..e5c95b3d79454cf688c362ff94ffa1691109c163 100644 (file)
--- a/vm/full_collector.cpp
+++ b/vm/full_collector.cpp
@@ -26,17 +26,13 @@ struct stack_frame_marker {
 /* Mark code blocks executing in currently active stack frames. */
 void full_collector::mark_active_blocks()
 {
-       context *stacks = this->myvm->stack_chain;
+       context *ctx = this->myvm->stack_chain;
 
-       while(stacks)
+       while(ctx)
        {
-               cell top = (cell)stacks->callstack_top;
-               cell bottom = (cell)stacks->callstack_bottom;
-
                stack_frame_marker marker(this);
-               myvm->iterate_callstack(top,bottom,marker);
-
-               stacks = stacks->next;
+               myvm->iterate_callstack(ctx,marker);
+               ctx = ctx->next;
        }
 }
 
@@ -140,7 +136,12 @@ void factor_vm::collect_full_impl(bool trace_contexts_p)
        nursery.here = nursery.start;
 }
 
-void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p)
+/* In both cases, compact code heap before updating code blocks so that
+XTs are correct after */
+
+void factor_vm::collect_growing_heap(cell requested_bytes,
+       bool trace_contexts_p,
+       bool compact_code_heap_p)
 {
        /* Grow the data heap and copy all live objects to the new heap. */
        data_heap *old = data;
@@ -148,18 +149,22 @@ void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p
        collect_full_impl(trace_contexts_p);
        delete old;
 
+       if(compact_code_heap_p) compact_code_heap(trace_contexts_p);
+
        after_growing_heap_updater updater(this);
        code->free_unmarked(updater);
        code->clear_remembered_set();
 }
 
-void factor_vm::collect_full(bool trace_contexts_p)
+void factor_vm::collect_full(bool trace_contexts_p, bool compact_code_heap_p)
 {
        /* Copy all live objects to the tenured semispace. */
        std::swap(data->tenured,data->tenured_semispace);
        reset_generation(data->tenured);
        collect_full_impl(trace_contexts_p);
 
+       if(compact_code_heap_p) compact_code_heap(trace_contexts_p);
+
        after_full_updater updater(this);
        code->free_unmarked(updater);
        code->clear_remembered_set();

diff --git a/vm/gc.cpp b/vm/gc.cpp
index 2fdfa1033b548f9961c76e7cf831fbb48732b8d0..ebfed1fa2304461bdf24f1684da4fac2f868de3a 100755 (executable)
--- a/vm/gc.cpp
+++ b/vm/gc.cpp
@@ -25,10 +25,10 @@ void factor_vm::record_gc_stats(generation_statistics *stats)
                stats->max_gc_time = gc_elapsed;
 }
 
-/* Collect gen and all younger generations.
-If growing_data_heap_ is true, we must grow the data heap to such a size that
-an allocation of requested_bytes won't fail */
-void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes)
+void factor_vm::gc(gc_op op,
+       cell requested_bytes,
+       bool trace_contexts_p,
+       bool compact_code_heap_p)
 {
        assert(!gc_off);
        assert(!current_gc);
@@ -80,11 +80,11 @@ void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell request
                record_gc_stats(&gc_stats.aging_stats);
                break;
        case collect_full_op:
-               collect_full(trace_contexts_p);
+               collect_full(trace_contexts_p,compact_code_heap_p);
                record_gc_stats(&gc_stats.full_stats);
                break;
        case collect_growing_heap_op:
-               collect_growing_heap(requested_bytes,trace_contexts_p);
+               collect_growing_heap(requested_bytes,trace_contexts_p,compact_code_heap_p);
                record_gc_stats(&gc_stats.full_stats);
                break;
        default:
@@ -96,14 +96,28 @@ void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell request
        current_gc = NULL;
 }
 
-void factor_vm::gc()
+void factor_vm::primitive_full_gc()
 {
-       garbage_collection(collect_full_op,true,0);
+       gc(collect_full_op,
+               0, /* requested size */
+               true, /* trace contexts? */
+               false /* compact code heap? */);
 }
 
-void factor_vm::primitive_gc()
+void factor_vm::primitive_minor_gc()
 {
-       gc();
+       gc(collect_nursery_op,
+               0, /* requested size */
+               true, /* trace contexts? */
+               false /* compact code heap? */);
+}
+
+void factor_vm::primitive_compact_gc()
+{
+       gc(collect_full_op,
+               0, /* requested size */
+               true, /* trace contexts? */
+               true /* compact code heap? */);
 }
 
 void factor_vm::add_gc_stats(generation_statistics *stats, growable_array *result)
@@ -171,7 +185,7 @@ void factor_vm::primitive_become()
                        old_obj->h.forward_to(new_obj.untagged());
        }
 
-       gc();
+       primitive_full_gc();
 
        /* If a word's definition quotation was in old_objects and the
           quotation in new_objects is not compiled, we might leak memory
@@ -185,7 +199,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
        for(cell i = 0; i < gc_roots_size; i++)
                gc_locals.push_back((cell)&gc_roots_base[i]);
 
-       garbage_collection(collect_nursery_op,true,0);
+       primitive_minor_gc();
 
        for(cell i = 0; i < gc_roots_size; i++)
                gc_locals.pop_back();
@@ -204,16 +218,18 @@ object *factor_vm::allot_object(header header, cell size)
 {
 #ifdef GC_DEBUG
        if(!gc_off)
-               gc();
+               primitive_full_gc();
 #endif
 
        object *obj;
 
+       /* If the object is smaller than the nursery, allocate it in the nursery,
+       after a GC if needed */
        if(nursery.size > size)
        {
                /* If there is insufficient room, collect the nursery */
                if(nursery.here + size > nursery.end)
-                       garbage_collection(collect_nursery_op,true,0);
+                       primitive_minor_gc();
 
                obj = nursery.allot(size);
        }
@@ -223,11 +239,16 @@ object *factor_vm::allot_object(header header, cell size)
        {
                /* If tenured space does not have enough room, collect */
                if(data->tenured->here + size > data->tenured->end)
-                       gc();
+                       primitive_full_gc();
 
                /* If it still won't fit, grow the heap */
                if(data->tenured->here + size > data->tenured->end)
-                       garbage_collection(collect_growing_heap_op,true,size);
+               {
+                       gc(collect_growing_heap_op,
+                               size, /* requested size */
+                               true, /* trace contexts? */
+                               false /* compact code heap? */);
+               }
 
                obj = data->tenured->allot(size);
 

diff --git a/vm/heap.cpp b/vm/heap.cpp
index 1689af3ee49f84fd22d7abccad185107002f8ac3..f6d17cd4d5af73020fd0a243fbf866f7f7ae8020 100644 (file)
--- a/vm/heap.cpp
+++ b/vm/heap.cpp
@@ -226,37 +226,32 @@ cell heap::heap_size()
                return seg->size;
 }
 
-/* Compute where each block is going to go, after compaction */
-cell heap::compute_heap_forwarding()
+void heap::compact_heap()
 {
+       forwarding.clear();
+
        heap_block *scan = first_block();
-       char *address = (char *)first_block();
+       char *address = (char *)scan;
 
+       /* Slide blocks up while building the forwarding hashtable. */
        while(scan)
        {
-               if(scan->type() != FREE_BLOCK_TYPE)
+               heap_block *next = next_block(scan);
+ 
+               if(scan->type() != FREE_BLOCK_TYPE && scan->marked_p())
                {
+                       cell size = scan->size();
+                       memmove(address,scan,size);
                        forwarding[scan] = address;
-                       address += scan->size();
+                       address += size;
                }
-               scan = next_block(scan);
-       }
-
-       return (cell)address - seg->start;
-}
-
-void heap::compact_heap()
-{
-       heap_block *scan = first_block();
-
-       while(scan)
-       {
-               heap_block *next = next_block(scan);
 
-               if(scan->type() != FREE_BLOCK_TYPE)
-                       memmove(forwarding[scan],scan,scan->size());
                scan = next;
        }
+
+       /* Now update the free list; there will be a single free block at
+       the end */
+       build_free_list((cell)address - seg->start);
 }
 
 heap_block *heap::free_allocated(heap_block *prev, heap_block *scan)

diff --git a/vm/heap.hpp b/vm/heap.hpp
index 7f9cd30dbbd86ad3d68e7f3b1a3ceb9e519d98a4..bc9653e3d7f3b30212a4a49a6015f69c341c2f4f 100644 (file)
--- a/vm/heap.hpp
+++ b/vm/heap.hpp
@@ -49,7 +49,6 @@ struct heap {
        void clear_mark_bits();
        void heap_usage(cell *used, cell *total_free, cell *max_free);
        cell heap_size();
-       cell compute_heap_forwarding();
        void compact_heap();
 
        heap_block *free_allocated(heap_block *prev, heap_block *scan);

diff --git a/vm/image.cpp b/vm/image.cpp
index cef318fc6aef9d2844072e3c77c685701db6fa87..96ec2ce93001a7d9350f4d4a0db6cb6c98fec05d 100755 (executable)
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -114,7 +114,7 @@ bool factor_vm::save_image(const vm_char *filename)
 void factor_vm::primitive_save_image()
 {
        /* do a full GC to push everything into tenured space */
-       gc();
+       primitive_full_gc();
 
        gc_root<byte_array> path(dpop(),this);
        path.untag_check(this);
@@ -135,8 +135,10 @@ void factor_vm::primitive_save_image_and_exit()
                if(!save_env_p(i)) userenv[i] = F;
        }
 
-       /* do a full GC + code heap compaction */
-       compact_code_heap();
+       gc(collect_full_op,
+               0, /* requested size */
+               false, /* discard objects only reachable from stacks */
+               true /* compact the code heap */);
 
        /* Save the image */
        if(save_image((vm_char *)(path.untagged() + 1)))

diff --git a/vm/primitives.cpp b/vm/primitives.cpp
index 9419518d795b1ba7235c1c9e39540ca912f122d7..cc3c89b47e881269f4d29acc383f33287dcdeede 100644 (file)
--- a/vm/primitives.cpp
+++ b/vm/primitives.cpp
@@ -3,6 +3,131 @@
 namespace factor
 {
 
+PRIMITIVE_FORWARD(bignum_to_fixnum)
+PRIMITIVE_FORWARD(float_to_fixnum)
+PRIMITIVE_FORWARD(fixnum_to_bignum)
+PRIMITIVE_FORWARD(float_to_bignum)
+PRIMITIVE_FORWARD(fixnum_to_float)
+PRIMITIVE_FORWARD(bignum_to_float)
+PRIMITIVE_FORWARD(str_to_float)
+PRIMITIVE_FORWARD(float_to_str)
+PRIMITIVE_FORWARD(float_bits)
+PRIMITIVE_FORWARD(double_bits)
+PRIMITIVE_FORWARD(bits_float)
+PRIMITIVE_FORWARD(bits_double)
+PRIMITIVE_FORWARD(fixnum_divint)
+PRIMITIVE_FORWARD(fixnum_divmod)
+PRIMITIVE_FORWARD(fixnum_shift)
+PRIMITIVE_FORWARD(bignum_eq)
+PRIMITIVE_FORWARD(bignum_add)
+PRIMITIVE_FORWARD(bignum_subtract)
+PRIMITIVE_FORWARD(bignum_multiply)
+PRIMITIVE_FORWARD(bignum_divint)
+PRIMITIVE_FORWARD(bignum_mod)
+PRIMITIVE_FORWARD(bignum_divmod)
+PRIMITIVE_FORWARD(bignum_and)
+PRIMITIVE_FORWARD(bignum_or)
+PRIMITIVE_FORWARD(bignum_xor)
+PRIMITIVE_FORWARD(bignum_not)
+PRIMITIVE_FORWARD(bignum_shift)
+PRIMITIVE_FORWARD(bignum_less)
+PRIMITIVE_FORWARD(bignum_lesseq)
+PRIMITIVE_FORWARD(bignum_greater)
+PRIMITIVE_FORWARD(bignum_greatereq)
+PRIMITIVE_FORWARD(bignum_bitp)
+PRIMITIVE_FORWARD(bignum_log2)
+PRIMITIVE_FORWARD(byte_array_to_bignum)
+PRIMITIVE_FORWARD(float_eq)
+PRIMITIVE_FORWARD(float_add)
+PRIMITIVE_FORWARD(float_subtract)
+PRIMITIVE_FORWARD(float_multiply)
+PRIMITIVE_FORWARD(float_divfloat)
+PRIMITIVE_FORWARD(float_mod)
+PRIMITIVE_FORWARD(float_less)
+PRIMITIVE_FORWARD(float_lesseq)
+PRIMITIVE_FORWARD(float_greater)
+PRIMITIVE_FORWARD(float_greatereq)
+PRIMITIVE_FORWARD(word)
+PRIMITIVE_FORWARD(word_xt)
+PRIMITIVE_FORWARD(getenv)
+PRIMITIVE_FORWARD(setenv)
+PRIMITIVE_FORWARD(existsp)
+PRIMITIVE_FORWARD(full_gc)
+PRIMITIVE_FORWARD(gc_stats)
+PRIMITIVE_FORWARD(save_image)
+PRIMITIVE_FORWARD(save_image_and_exit)
+PRIMITIVE_FORWARD(datastack)
+PRIMITIVE_FORWARD(retainstack)
+PRIMITIVE_FORWARD(callstack)
+PRIMITIVE_FORWARD(set_datastack)
+PRIMITIVE_FORWARD(set_retainstack)
+PRIMITIVE_FORWARD(set_callstack)
+PRIMITIVE_FORWARD(exit)
+PRIMITIVE_FORWARD(data_room)
+PRIMITIVE_FORWARD(code_room)
+PRIMITIVE_FORWARD(micros)
+PRIMITIVE_FORWARD(modify_code_heap)
+PRIMITIVE_FORWARD(dlopen)
+PRIMITIVE_FORWARD(dlsym)
+PRIMITIVE_FORWARD(dlclose)
+PRIMITIVE_FORWARD(byte_array)
+PRIMITIVE_FORWARD(uninitialized_byte_array)
+PRIMITIVE_FORWARD(displaced_alien)
+PRIMITIVE_FORWARD(alien_address)
+PRIMITIVE_FORWARD(set_slot)
+PRIMITIVE_FORWARD(string_nth)
+PRIMITIVE_FORWARD(set_string_nth_fast)
+PRIMITIVE_FORWARD(set_string_nth_slow)
+PRIMITIVE_FORWARD(resize_array)
+PRIMITIVE_FORWARD(resize_string)
+PRIMITIVE_FORWARD(array)
+PRIMITIVE_FORWARD(begin_scan)
+PRIMITIVE_FORWARD(next_object)
+PRIMITIVE_FORWARD(end_scan)
+PRIMITIVE_FORWARD(size)
+PRIMITIVE_FORWARD(die)
+PRIMITIVE_FORWARD(fopen)
+PRIMITIVE_FORWARD(fgetc)
+PRIMITIVE_FORWARD(fread)
+PRIMITIVE_FORWARD(fputc)
+PRIMITIVE_FORWARD(fwrite)
+PRIMITIVE_FORWARD(fflush)
+PRIMITIVE_FORWARD(ftell)
+PRIMITIVE_FORWARD(fseek)
+PRIMITIVE_FORWARD(fclose)
+PRIMITIVE_FORWARD(wrapper)
+PRIMITIVE_FORWARD(clone)
+PRIMITIVE_FORWARD(string)
+PRIMITIVE_FORWARD(array_to_quotation)
+PRIMITIVE_FORWARD(quotation_xt)
+PRIMITIVE_FORWARD(tuple)
+PRIMITIVE_FORWARD(profiling)
+PRIMITIVE_FORWARD(become)
+PRIMITIVE_FORWARD(sleep)
+PRIMITIVE_FORWARD(tuple_boa)
+PRIMITIVE_FORWARD(callstack_to_array)
+PRIMITIVE_FORWARD(innermost_stack_frame_executing)
+PRIMITIVE_FORWARD(innermost_stack_frame_scan)
+PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
+PRIMITIVE_FORWARD(call_clear)
+PRIMITIVE_FORWARD(resize_byte_array)
+PRIMITIVE_FORWARD(dll_validp)
+PRIMITIVE_FORWARD(unimplemented)
+PRIMITIVE_FORWARD(clear_gc_stats)
+PRIMITIVE_FORWARD(jit_compile)
+PRIMITIVE_FORWARD(load_locals)
+PRIMITIVE_FORWARD(check_datastack)
+PRIMITIVE_FORWARD(mega_cache_miss)
+PRIMITIVE_FORWARD(lookup_method)
+PRIMITIVE_FORWARD(reset_dispatch_stats)
+PRIMITIVE_FORWARD(dispatch_stats)
+PRIMITIVE_FORWARD(reset_inline_cache_stats)
+PRIMITIVE_FORWARD(inline_cache_stats)
+PRIMITIVE_FORWARD(optimized_p)
+PRIMITIVE_FORWARD(quot_compiled_p)
+PRIMITIVE_FORWARD(vm_ptr)
+PRIMITIVE_FORWARD(strip_stack_traces)
+
 const primitive_type primitives[] = {
        primitive_bignum_to_fixnum,
        primitive_float_to_fixnum,
@@ -62,7 +187,7 @@ const primitive_type primitives[] = {
        primitive_getenv,
        primitive_setenv,
        primitive_existsp,
-       primitive_gc,
+       primitive_full_gc,
        primitive_gc_stats,
        primitive_save_image,
        primitive_save_image_and_exit,
@@ -167,129 +292,4 @@ const primitive_type primitives[] = {
        primitive_strip_stack_traces,
 };
 
-PRIMITIVE_FORWARD(bignum_to_fixnum)
-PRIMITIVE_FORWARD(float_to_fixnum)
-PRIMITIVE_FORWARD(fixnum_to_bignum)
-PRIMITIVE_FORWARD(float_to_bignum)
-PRIMITIVE_FORWARD(fixnum_to_float)
-PRIMITIVE_FORWARD(bignum_to_float)
-PRIMITIVE_FORWARD(str_to_float)
-PRIMITIVE_FORWARD(float_to_str)
-PRIMITIVE_FORWARD(float_bits)
-PRIMITIVE_FORWARD(double_bits)
-PRIMITIVE_FORWARD(bits_float)
-PRIMITIVE_FORWARD(bits_double)
-PRIMITIVE_FORWARD(fixnum_divint)
-PRIMITIVE_FORWARD(fixnum_divmod)
-PRIMITIVE_FORWARD(fixnum_shift)
-PRIMITIVE_FORWARD(bignum_eq)
-PRIMITIVE_FORWARD(bignum_add)
-PRIMITIVE_FORWARD(bignum_subtract)
-PRIMITIVE_FORWARD(bignum_multiply)
-PRIMITIVE_FORWARD(bignum_divint)
-PRIMITIVE_FORWARD(bignum_mod)
-PRIMITIVE_FORWARD(bignum_divmod)
-PRIMITIVE_FORWARD(bignum_and)
-PRIMITIVE_FORWARD(bignum_or)
-PRIMITIVE_FORWARD(bignum_xor)
-PRIMITIVE_FORWARD(bignum_not)
-PRIMITIVE_FORWARD(bignum_shift)
-PRIMITIVE_FORWARD(bignum_less)
-PRIMITIVE_FORWARD(bignum_lesseq)
-PRIMITIVE_FORWARD(bignum_greater)
-PRIMITIVE_FORWARD(bignum_greatereq)
-PRIMITIVE_FORWARD(bignum_bitp)
-PRIMITIVE_FORWARD(bignum_log2)
-PRIMITIVE_FORWARD(byte_array_to_bignum)
-PRIMITIVE_FORWARD(float_eq)
-PRIMITIVE_FORWARD(float_add)
-PRIMITIVE_FORWARD(float_subtract)
-PRIMITIVE_FORWARD(float_multiply)
-PRIMITIVE_FORWARD(float_divfloat)
-PRIMITIVE_FORWARD(float_mod)
-PRIMITIVE_FORWARD(float_less)
-PRIMITIVE_FORWARD(float_lesseq)
-PRIMITIVE_FORWARD(float_greater)
-PRIMITIVE_FORWARD(float_greatereq)
-PRIMITIVE_FORWARD(word)
-PRIMITIVE_FORWARD(word_xt)
-PRIMITIVE_FORWARD(getenv)
-PRIMITIVE_FORWARD(setenv)
-PRIMITIVE_FORWARD(existsp)
-PRIMITIVE_FORWARD(gc)
-PRIMITIVE_FORWARD(gc_stats)
-PRIMITIVE_FORWARD(save_image)
-PRIMITIVE_FORWARD(save_image_and_exit)
-PRIMITIVE_FORWARD(datastack)
-PRIMITIVE_FORWARD(retainstack)
-PRIMITIVE_FORWARD(callstack)
-PRIMITIVE_FORWARD(set_datastack)
-PRIMITIVE_FORWARD(set_retainstack)
-PRIMITIVE_FORWARD(set_callstack)
-PRIMITIVE_FORWARD(exit)
-PRIMITIVE_FORWARD(data_room)
-PRIMITIVE_FORWARD(code_room)
-PRIMITIVE_FORWARD(micros)
-PRIMITIVE_FORWARD(modify_code_heap)
-PRIMITIVE_FORWARD(dlopen)
-PRIMITIVE_FORWARD(dlsym)
-PRIMITIVE_FORWARD(dlclose)
-PRIMITIVE_FORWARD(byte_array)
-PRIMITIVE_FORWARD(uninitialized_byte_array)
-PRIMITIVE_FORWARD(displaced_alien)
-PRIMITIVE_FORWARD(alien_address)
-PRIMITIVE_FORWARD(set_slot)
-PRIMITIVE_FORWARD(string_nth)
-PRIMITIVE_FORWARD(set_string_nth_fast)
-PRIMITIVE_FORWARD(set_string_nth_slow)
-PRIMITIVE_FORWARD(resize_array)
-PRIMITIVE_FORWARD(resize_string)
-PRIMITIVE_FORWARD(array)
-PRIMITIVE_FORWARD(begin_scan)
-PRIMITIVE_FORWARD(next_object)
-PRIMITIVE_FORWARD(end_scan)
-PRIMITIVE_FORWARD(size)
-PRIMITIVE_FORWARD(die)
-PRIMITIVE_FORWARD(fopen)
-PRIMITIVE_FORWARD(fgetc)
-PRIMITIVE_FORWARD(fread)
-PRIMITIVE_FORWARD(fputc)
-PRIMITIVE_FORWARD(fwrite)
-PRIMITIVE_FORWARD(fflush)
-PRIMITIVE_FORWARD(ftell)
-PRIMITIVE_FORWARD(fseek)
-PRIMITIVE_FORWARD(fclose)
-PRIMITIVE_FORWARD(wrapper)
-PRIMITIVE_FORWARD(clone)
-PRIMITIVE_FORWARD(string)
-PRIMITIVE_FORWARD(array_to_quotation)
-PRIMITIVE_FORWARD(quotation_xt)
-PRIMITIVE_FORWARD(tuple)
-PRIMITIVE_FORWARD(profiling)
-PRIMITIVE_FORWARD(become)
-PRIMITIVE_FORWARD(sleep)
-PRIMITIVE_FORWARD(tuple_boa)
-PRIMITIVE_FORWARD(callstack_to_array)
-PRIMITIVE_FORWARD(innermost_stack_frame_executing)
-PRIMITIVE_FORWARD(innermost_stack_frame_scan)
-PRIMITIVE_FORWARD(set_innermost_stack_frame_quot)
-PRIMITIVE_FORWARD(call_clear)
-PRIMITIVE_FORWARD(resize_byte_array)
-PRIMITIVE_FORWARD(dll_validp)
-PRIMITIVE_FORWARD(unimplemented)
-PRIMITIVE_FORWARD(clear_gc_stats)
-PRIMITIVE_FORWARD(jit_compile)
-PRIMITIVE_FORWARD(load_locals)
-PRIMITIVE_FORWARD(check_datastack)
-PRIMITIVE_FORWARD(mega_cache_miss)
-PRIMITIVE_FORWARD(lookup_method)
-PRIMITIVE_FORWARD(reset_dispatch_stats)
-PRIMITIVE_FORWARD(dispatch_stats)
-PRIMITIVE_FORWARD(reset_inline_cache_stats)
-PRIMITIVE_FORWARD(inline_cache_stats)
-PRIMITIVE_FORWARD(optimized_p)
-PRIMITIVE_FORWARD(quot_compiled_p)
-PRIMITIVE_FORWARD(vm_ptr)
-PRIMITIVE_FORWARD(strip_stack_traces)
-
 }

diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index 7eaa13d8a17c6b58944316ddfc53c3a5a7f95eb4..467eef473ee7674d2625e7f7c1851814ba327321 100644 (file)
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -18,79 +18,14 @@ namespace factor
 #endif
 extern const primitive_type primitives[];
 
-PRIMITIVE(bignum_to_fixnum);
-PRIMITIVE(float_to_fixnum);
-PRIMITIVE(fixnum_to_bignum);
-PRIMITIVE(float_to_bignum);
-PRIMITIVE(fixnum_to_float);
-PRIMITIVE(bignum_to_float);
-PRIMITIVE(str_to_float);
-PRIMITIVE(float_to_str);
-PRIMITIVE(float_bits);
-PRIMITIVE(double_bits);
-PRIMITIVE(bits_float);
-PRIMITIVE(bits_double);
+/* These are defined in assembly */
 PRIMITIVE(fixnum_add);
 PRIMITIVE(fixnum_subtract);
 PRIMITIVE(fixnum_multiply);
-PRIMITIVE(fixnum_divint);
-PRIMITIVE(fixnum_divmod);
-PRIMITIVE(fixnum_shift);
-PRIMITIVE(bignum_eq);
-PRIMITIVE(bignum_add);
-PRIMITIVE(bignum_subtract);
-PRIMITIVE(bignum_multiply);
-PRIMITIVE(bignum_divint);
-PRIMITIVE(bignum_mod);
-PRIMITIVE(bignum_divmod);
-PRIMITIVE(bignum_and);
-PRIMITIVE(bignum_or);
-PRIMITIVE(bignum_xor);
-PRIMITIVE(bignum_not);
-PRIMITIVE(bignum_shift);
-PRIMITIVE(bignum_less);
-PRIMITIVE(bignum_lesseq);
-PRIMITIVE(bignum_greater);
-PRIMITIVE(bignum_greatereq);
-PRIMITIVE(bignum_bitp);
-PRIMITIVE(bignum_log2);
-PRIMITIVE(byte_array_to_bignum);
-PRIMITIVE(float_eq);
-PRIMITIVE(float_add);
-PRIMITIVE(float_subtract);
-PRIMITIVE(float_multiply);
-PRIMITIVE(float_divfloat);
-PRIMITIVE(float_mod);
-PRIMITIVE(float_less);
-PRIMITIVE(float_lesseq);
-PRIMITIVE(float_greater);
-PRIMITIVE(float_greatereq);
-PRIMITIVE(word);
-PRIMITIVE(word_xt);
-PRIMITIVE(getenv);
-PRIMITIVE(setenv);
-PRIMITIVE(existsp);
-PRIMITIVE(gc);
-PRIMITIVE(gc_stats);
-PRIMITIVE(save_image);
-PRIMITIVE(save_image_and_exit);
-PRIMITIVE(datastack);
-PRIMITIVE(retainstack);
-PRIMITIVE(callstack);
-PRIMITIVE(set_datastack);
-PRIMITIVE(set_retainstack);
-PRIMITIVE(set_callstack);
-PRIMITIVE(exit);
-PRIMITIVE(data_room);
-PRIMITIVE(code_room);
-PRIMITIVE(micros);
-PRIMITIVE(modify_code_heap);
-PRIMITIVE(dlopen);
-PRIMITIVE(dlsym);
-PRIMITIVE(dlclose);
-PRIMITIVE(byte_array);
-PRIMITIVE(uninitialized_byte_array);
-PRIMITIVE(displaced_alien);
+PRIMITIVE(inline_cache_miss);
+PRIMITIVE(inline_cache_miss_tail);
+
+/* These are generated with macros in alien.c */
 PRIMITIVE(alien_signed_cell);
 PRIMITIVE(set_alien_signed_cell);
 PRIMITIVE(alien_unsigned_cell);
@@ -117,61 +52,5 @@ PRIMITIVE(alien_double);
 PRIMITIVE(set_alien_double);
 PRIMITIVE(alien_cell);
 PRIMITIVE(set_alien_cell);
-PRIMITIVE(alien_address);
-PRIMITIVE(set_slot);
-PRIMITIVE(string_nth);
-PRIMITIVE(set_string_nth_fast);
-PRIMITIVE(set_string_nth_slow);
-PRIMITIVE(resize_array);
-PRIMITIVE(resize_string);
-PRIMITIVE(array);
-PRIMITIVE(begin_scan);
-PRIMITIVE(next_object);
-PRIMITIVE(end_scan);
-PRIMITIVE(size);
-PRIMITIVE(die);
-PRIMITIVE(fopen);
-PRIMITIVE(fgetc);
-PRIMITIVE(fread);
-PRIMITIVE(fputc);
-PRIMITIVE(fwrite);
-PRIMITIVE(fflush);
-PRIMITIVE(ftell);
-PRIMITIVE(fseek);
-PRIMITIVE(fclose);
-PRIMITIVE(wrapper);
-PRIMITIVE(clone);
-PRIMITIVE(string);
-PRIMITIVE(array_to_quotation);
-PRIMITIVE(quotation_xt);
-PRIMITIVE(tuple);
-PRIMITIVE(profiling);
-PRIMITIVE(become);
-PRIMITIVE(sleep);
-PRIMITIVE(tuple_boa);
-PRIMITIVE(callstack_to_array);
-PRIMITIVE(innermost_stack_frame_executing);
-PRIMITIVE(innermost_stack_frame_scan);
-PRIMITIVE(set_innermost_stack_frame_quot);
-PRIMITIVE(call_clear);
-PRIMITIVE(resize_byte_array);
-PRIMITIVE(dll_validp);
-PRIMITIVE(unimplemented);
-PRIMITIVE(clear_gc_stats);
-PRIMITIVE(jit_compile);
-PRIMITIVE(load_locals);
-PRIMITIVE(check_datastack);
-PRIMITIVE(inline_cache_miss);
-PRIMITIVE(inline_cache_miss_tail);
-PRIMITIVE(mega_cache_miss);
-PRIMITIVE(lookup_method);
-PRIMITIVE(reset_dispatch_stats);
-PRIMITIVE(dispatch_stats);
-PRIMITIVE(reset_inline_cache_stats);
-PRIMITIVE(inline_cache_stats);
-PRIMITIVE(optimized_p);
-PRIMITIVE(quot_compiled_p);
-PRIMITIVE(vm_ptr);
-PRIMITIVE(strip_stack_traces);
 
 }

diff --git a/vm/profiler.cpp b/vm/profiler.cpp
index 228b163f837cac06b6840d01ce41bd2b5273b1b7..4674b726b1adfd65f8ccc5415581c94904d57c9d 100755 (executable)
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -29,7 +29,7 @@ void factor_vm::set_profiling(bool profiling)
 
        /* Push everything to tenured space so that we can heap scan
        and allocate profiling blocks if necessary */
-       gc();
+       primitive_full_gc();
 
        gc_root<array> words(find_all_words(),this);
 

diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 77d1852f36959c6b5a71346aeab8b1abb87f16ee..6f4da51869b7dd60e8609f65747c3bb412944fa9 100755 (executable)
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -283,9 +283,7 @@ void quotation_jit::iterate_quotation()
 
 void factor_vm::set_quot_xt(quotation *quot, code_block *code)
 {
-       if(code->type() != QUOTATION_TYPE)
-               critical_error("Bad param to set_quot_xt",(cell)code);
-
+       assert(code->type() == QUOTATION_TYPE);
        quot->code = code;
        quot->xt = code->xt();
 }

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 3b0592aedba71a0d8f14566d329882e4e8f80ee3..5031260da4f78b8dfc870546f07e2a4a8654a1af 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -239,12 +239,13 @@ struct factor_vm
        void collect_aging();
        void collect_to_tenured();
        void collect_full_impl(bool trace_contexts_p);
-       void collect_growing_heap(cell requested_bytes, bool trace_contexts_p);
-       void collect_full(bool trace_contexts_p);
+       void collect_growing_heap(cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p);
+       void collect_full(bool trace_contexts_p, bool compact_code_heap_p);
        void record_gc_stats(generation_statistics *stats);
-       void garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes);
-       void gc();
-       void primitive_gc();
+       void gc(gc_op op, cell requested_bytes, bool trace_contexts_p, bool compact_code_heap_p);
+       void primitive_full_gc();
+       void primitive_minor_gc();
+       void primitive_compact_gc();
        void primitive_gc_stats();
        void clear_gc_stats();
        void primitive_become();
@@ -499,10 +500,9 @@ struct factor_vm
        void update_code_heap_words();
        void primitive_modify_code_heap();
        void primitive_code_room();
-       code_block *forward_xt(code_block *compiled);
        void forward_object_xts();
-       void fixup_object_xts();
-       void compact_code_heap();
+       void forward_context_xts();
+       void compact_code_heap(bool trace_contexts_p);
        void primitive_strip_stack_traces();
 
        /* Apply a function to every code block */
@@ -557,7 +557,7 @@ struct factor_vm
        void primitive_innermost_stack_frame_scan();
        void primitive_set_innermost_stack_frame_quot();
        void save_callstack_bottom(stack_frame *callstack_bottom);
-       template<typename Iterator> void iterate_callstack(cell top, cell bottom, Iterator &iterator);
+       template<typename Iterator> void iterate_callstack(context *ctx, Iterator &iterator);
 
        /* Every object has a regular representation in the runtime, which makes GC
        much simpler. Every slot of the object until binary_payload_start is a pointer