Merge branch 'master' of git://factorcode.org/git/factor

Makefile

@@ -58,6 +58,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm/math.o \
 	vm/nursery_collector.o \
 	vm/object_start_map.o \
+	vm/objects.o \
 	vm/primitives.o \
 	vm/profiler.o \
 	vm/quotations.o \

basis/compiler/tree/propagation/transforms/transforms.factor

@@ -3,7 +3,7 @@
 USING: kernel sequences words fry generic accessors
 classes.tuple classes classes.algebra definitions
 stack-checker.state quotations classes.tuple.private math
-math.partial-dispatch math.private math.intervals
+math.partial-dispatch math.private math.intervals sets.private
 math.floats.private math.integers.private layouts math.order
 vectors hashtables combinators effects generalizations assocs
 sets combinators.short-circuit sequences.private locals
@@ -290,3 +290,13 @@ CONSTANT: lookup-table-at-max 256
     ] [ drop f ] if ;
 
 \ at* [ at-quot ] 1 define-partial-eval
+
+: diff-quot ( seq -- quot: ( seq' -- seq'' ) )
+    tester '[ [ @ not ] filter ] ;
+
+\ diff [ diff-quot ] 1 define-partial-eval
+
+: intersect-quot ( seq -- quot: ( seq' -- seq'' ) )
+    tester '[ _ filter ] ;
+
+\ intersect [ intersect-quot ] 1 define-partial-eval

basis/compression/run-length/run-length.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators grouping kernel locals math
-math.matrices math.order multiline sequence-parser sequences
+math.matrices math.order multiline sequences.parser sequences
 tools.continuations ;
 IN: compression.run-length
 

basis/debugger/debugger-docs.factor

@@ -129,9 +129,6 @@ HELP: c-string-error.
 HELP: ffi-error.
 { $error-description "Thrown by " { $link dlopen } " and " { $link dlsym } " if a problem occurs while loading a native library or looking up a symbol. See " { $link "alien" } "." } ;
 
-HELP: heap-scan-error.
-{ $error-description "Thrown if " { $link next-object } " is called outside of a " { $link begin-scan } "/" { $link end-scan } " pair." } ;
-
 HELP: undefined-symbol-error.
 { $error-description "Thrown if a previously-compiled " { $link alien-invoke } " call refers to a native library symbol which no longer exists." } ;
 

basis/debugger/debugger.factor

@@ -103,9 +103,6 @@ HOOK: signal-error. os ( obj -- )
 : ffi-error. ( obj -- )
     "FFI error" print drop ;
 
-: heap-scan-error. ( obj -- )
-    "Cannot do next-object outside begin/end-scan" print drop ;
-
 : undefined-symbol-error. ( obj -- )
     "The image refers to a library or symbol that was not found at load time"
     print drop ;
@@ -148,14 +145,13 @@ PREDICATE: vm-error < array
         { 6  [ array-size-error.       ] }
         { 7  [ c-string-error.         ] }
         { 8  [ ffi-error.              ] }
-        { 9  [ heap-scan-error.        ] }
+        { 9  [ undefined-symbol-error. ] }
-        { 10 [ undefined-symbol-error. ] }
+        { 10 [ datastack-underflow.    ] }
-        { 11 [ datastack-underflow.    ] }
+        { 11 [ datastack-overflow.     ] }
-        { 12 [ datastack-overflow.     ] }
+        { 12 [ retainstack-underflow.  ] }
-        { 13 [ retainstack-underflow.  ] }
+        { 13 [ retainstack-overflow.   ] }
-        { 14 [ retainstack-overflow.   ] }
+        { 14 [ memory-error.           ] }
-        { 15 [ memory-error.           ] }
+        { 15 [ fp-trap-error.          ] }
-        { 16 [ fp-trap-error.          ] }
     } ; inline
 
 M: vm-error summary drop "VM error" ;

basis/math/statistics/statistics-docs.factor

@@ -98,6 +98,19 @@ HELP: histogram*
 }
 { $description "Takes an existing hashtable and uses " { $link histogram } " to continue counting the number of occurences of each element." } ;
 
+HELP: sorted-histogram
+{ $values
+    { "seq" sequence }
+    { "alist" "an array of key/value pairs" }
+}
+{ $description "Outputs a " { $link histogram } " of a sequence sorted by number of occurences from lowest to highest." }
+{ $examples
+    { $example "USING: prettyprint math.statistics ;"
+        """"abababbbbbbc" sorted-histogram ."""
+        "{ { 99 1 } { 97 3 } { 98 8 } }"
+    }
+} ;
+
 HELP: sequence>assoc
 { $values
     { "seq" sequence } { "quot" quotation } { "exemplar" "an exemplar assoc" }
@@ -145,6 +158,7 @@ ARTICLE: "histogram" "Computing histograms"
 { $subsections
     histogram
     histogram*
+    sorted-histogram
 }
 "Combinators for implementing histogram:"
 { $subsections

basis/math/statistics/statistics.factor

@@ -79,6 +79,9 @@ PRIVATE>
 : histogram ( seq -- hashtable )
     [ inc-at ] sequence>hashtable ;
 
+: sorted-histogram ( seq -- alist )
+    histogram >alist sort-values ;
+
 : collect-values ( seq quot: ( obj hashtable -- ) -- hash )
     '[ [ dup @ ] dip push-at ] sequence>hashtable ; inline
 

basis/sequences/parser/authors.txt

@@ -0,0 +1,2 @@
+Daniel Ehrenberg
+Doug Coleman

basis/sequences/parser/parser-tests.factor

@@ -1,6 +1,6 @@
 USING: tools.test sequence-parser unicode.categories kernel
 accessors ;
-IN: sequence-parser.tests
+IN: sequences.parser.tests
 
 [ "hello" ]
 [ "hello" [ take-rest ] parse-sequence ] unit-test

basis/sequences/parser/parser.factor

@@ -3,7 +3,7 @@
 USING: accessors circular combinators.short-circuit fry io
 kernel locals math math.order sequences sorting.functor
 sorting.slots unicode.categories ;
-IN: sequence-parser
+IN: sequences.parser
 
 TUPLE: sequence-parser sequence n ;
 

basis/stack-checker/known-words/known-words.factor

@@ -623,11 +623,7 @@ M: bad-executable summary
 \ <array> { integer object } { array } define-primitive
 \ <array> make-flushable
 
-\ begin-scan { } { } define-primitive
+\ all-instances { } { array } define-primitive
-
-\ next-object { } { object } define-primitive
-
-\ end-scan { } { } define-primitive
 
 \ size { object } { fixnum } define-primitive
 \ size make-flushable

basis/tools/memory/memory-docs.factor

@@ -13,11 +13,8 @@ ARTICLE: "tools.memory" "Object memory tools"
     data-room
     code-room
 }
-"There are a pair of combinators, analogous to " { $link each } " and " { $link filter } ", which operate on the entire collection of objects in the object heap:"
+"A combinator to get objects from the heap:"
-{ $subsections
+{ $subsections instances }
-    each-object
-    instances
-}
 "You can check an object's the heap memory usage:"
 { $subsections size }
 "The garbage collector can be invoked manually:"

basis/vm/vm.factor

@@ -3,7 +3,7 @@
 USING: classes.struct alien.c-types alien.syntax ;
 IN: vm
 
-TYPEDEF: intptr_t cell
+TYPEDEF: uintptr_t cell
 C-TYPE: context
 
 STRUCT: zone

core/bootstrap/primitives.factor

@@ -473,9 +473,7 @@ tuple
     { "resize-array" "arrays" (( n array -- newarray )) }
     { "resize-string" "strings" (( n str -- newstr )) }
     { "<array>" "arrays" (( n elt -- array )) }
-    { "begin-scan" "memory" (( -- )) }
+    { "all-instances" "memory" (( -- array )) }
-    { "next-object" "memory" (( -- obj )) }
-    { "end-scan" "memory" (( -- )) }
     { "size" "memory" (( obj -- n )) }
     { "die" "kernel" (( -- )) }
     { "(fopen)" "io.streams.c" (( path mode -- alien )) }

core/bootstrap/stage1.factor

@@ -17,25 +17,19 @@ load-help? off
 ! Create a boot quotation for the target
 [
     [
-        ! Rehash hashtables, since bootstrap.image creates them
+        ! Rehash hashtables first, since bootstrap.image creates
-        ! using the host image's hashing algorithms. We don't
+        ! them using the host image's hashing algorithms.
-        ! use each-object here since the catch stack isn't yet
+        [ hashtable? ] instances [ rehash ] each
-        ! set up.
-        gc
-        begin-scan
-        [ hashtable? ] pusher [ (each-object) ] dip
-        end-scan
-        [ rehash ] each
         boot
     ] %
 
     "math.integers" require
     "math.floats" require
     "memory" require
-    
+
     "io.streams.c" require
     "vocabs.loader" require
-    
+
     "syntax" require
     "bootstrap.layouts" require
 

core/memory/memory-docs.factor

@@ -2,31 +2,9 @@ USING: help.markup help.syntax debugger sequences kernel
 quotations math ;
 IN: memory
 
-HELP: begin-scan ( -- )
-{ $description "Disables the garbage collector and resets the heap scan pointer to point at the first object in the heap. The " { $link next-object } " word can then be called to advance the heap scan pointer and return successive objects."
-$nl
-"This word must always be paired with a call to " { $link end-scan } "." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: next-object ( -- obj )
-{ $values { "obj" object } }
-{ $description "Outputs the object at the heap scan pointer, and then advances the heap scan pointer. If the end of the heap has been reached, outputs " { $link f } ". This is unambiguous since the " { $link f } " object is tagged immediate and not actually stored in the heap." }
-{ $errors "Throws a " { $link heap-scan-error. } " if called outside a " { $link begin-scan } "/" { $link end-scan } " pair." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: end-scan ( -- )
-{ $description "Finishes a heap iteration by re-enabling the garbage collector. This word must always be paired with a call to " { $link begin-scan } "." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: each-object
-{ $values { "quot" { $quotation "( obj -- )" } } }
-{ $description "Applies a quotation to each object in the heap. The garbage collector is switched off while this combinator runs, so the given quotation must not allocate too much memory." }
-{ $notes "This word is the low-level facility used to implement the " { $link instances } " word." } ;
-
 HELP: instances
 { $values { "quot" { $quotation "( obj -- ? )" } } { "seq" "a fresh sequence" } }
-{ $description "Outputs a sequence of all objects in the heap which satisfy the quotation." }
+{ $description "Outputs a sequence of all objects in the heap which satisfy the quotation." } ;
-{ $notes "This word relies on " { $link each-object } ", so in particular the garbage collector is switched off while it runs and the given quotation must not allocate too much memory." } ;
 
 HELP: gc ( -- )
 { $description "Performs a full garbage collection." } ;
@@ -56,17 +34,6 @@ HELP: save-image-and-exit ( path -- )
 HELP: save
 { $description "Saves a snapshot of the heap to the current image file." } ;
 
-HELP: count-instances
-{ $values
-     { "quot" quotation }
-     { "n" integer } }
-{ $description "Applies the predicate quotation to each object in the heap and returns the number of objects that match. Since this word uses " { $link each-object } " with the garbage collector switched off, avoid allocating too much memory in the quotation." }
-{ $examples { $unchecked-example
-    "USING: memory words prettyprint ;"
-    "[ word? ] count-instances ."
-    "24210"
-} } ;
-
 ARTICLE: "images" "Images"
 "Factor has the ability to save the entire state of the system into an " { $emphasis "image file" } ". The image contains a complete dump of all data and code in the current Factor instance."
 { $subsections

core/memory/memory.factor

@@ -1,26 +1,11 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations sequences vectors arrays system math
+USING: kernel continuations sequences system
 io.backend alien.strings memory.private ;
 IN: memory
 
-: (each-object) ( quot: ( obj -- ) -- )
-    next-object dup [
-        swap [ call ] keep (each-object)
-    ] [ 2drop ] if ; inline recursive
-
-: each-object ( quot -- )
-    gc begin-scan [ (each-object) ] [ end-scan ] [ ] cleanup ; inline
-
-: count-instances ( quot -- n )
-    0 swap [ 1 0 ? + ] compose each-object ; inline
-
 : instances ( quot -- seq )
-    #! To ensure we don't need to grow the vector while scanning
+    [ all-instances ] dip filter ; inline
-    #! the heap, we do two scans, the first one just counts the
-    #! number of objects that satisfy the predicate.
-    [ count-instances 100 + <vector> ] keep swap
-    [ [ push-if ] 2curry each-object ] keep >array ; inline
 
 : save-image ( path -- )
     normalize-path native-string>alien (save-image) ;

extra/c/lexer/lexer-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors c.lexer kernel sequence-parser tools.test ;
+USING: accessors c.lexer kernel sequences.parser tools.test ;
 IN: c.lexer.tests
 
 [ 36 ]

extra/c/lexer/lexer.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors combinators combinators.short-circuit
 generalizations kernel locals math.order math.ranges
-sequence-parser sequences sorting.functor sorting.slots
+sequences.parser sequences sorting.functor sorting.slots
 unicode.categories ;
 IN: c.lexer
 

extra/c/preprocessor/preprocessor.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequence-parser io io.encodings.utf8 io.files
+USING: sequences.parser io io.encodings.utf8 io.files
 io.streams.string kernel combinators accessors io.pathnames
 fry sequences arrays locals namespaces io.directories
 assocs math splitting make unicode.categories

extra/html/parser/parser.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays hashtables sequence-parser
+USING: accessors arrays hashtables sequences.parser
 html.parser.utils kernel namespaces sequences math
 unicode.case unicode.categories combinators.short-circuit
 quoting fry ;

vm/aging_space.hpp

@@ -15,15 +15,6 @@ struct aging_space : bump_allocator<object> {
 		starts.record_object_start_offset(obj);
 		return obj;
 	}
-
-	cell next_object_after(cell scan)
-	{
-		cell size = ((object *)scan)->size();
-		if(scan + size < here)
-			return scan + size;
-		else
-			return 0;
-	}
 };
 
 }

vm/bitwise_hacks.hpp

@@ -3,65 +3,60 @@ namespace factor
 
 /* These algorithms were snarfed from various places. I did not come up with them myself */
 
-inline cell popcount(u64 x)
+inline cell popcount(cell x)
 {
+#ifdef FACTOR_64
 	u64 k1 = 0x5555555555555555ll;
 	u64 k2 = 0x3333333333333333ll;
 	u64 k4 = 0x0f0f0f0f0f0f0f0fll;
 	u64 kf = 0x0101010101010101ll;
+	cell ks = 56;
+#else
+	u32 k1 = 0x55555555;
+	u32 k2 = 0x33333333;
+	u32 k4 = 0xf0f0f0f;
+	u32 kf = 0x1010101;
+	cell ks = 24;
+#endif
+
 	x =  x       - ((x >> 1)  & k1); // put count of each 2 bits into those 2 bits
 	x = (x & k2) + ((x >> 2)  & k2); // put count of each 4 bits into those 4 bits
 	x = (x       +  (x >> 4)) & k4 ; // put count of each 8 bits into those 8 bits
-	x = (x * kf) >> 56; // returns 8 most significant bits of x + (x<<8) + (x<<16) + (x<<24) + ...
+	x = (x * kf) >> ks; // returns 8 most significant bits of x + (x<<8) + (x<<16) + (x<<24) + ...
 
 	return (cell)x;
 }
 
-inline cell log2(u64 x)
+inline cell log2(cell x)
 {
-#ifdef FACTOR_AMD64
+#if defined(FACTOR_X86)
 	cell n;
-	asm ("bsr %1, %0;":"=r"(n):"r"((cell)x));
+	asm ("bsr %1, %0;":"=r"(n):"r"(x));
+#elif defined(FACTOR_AMD64)
+	cell n;
+	asm ("bsr %1, %0;":"=r"(n):"r"(x));
 #else
 	cell n = 0;
+#ifdef FACTOR_64
 	if (x >= (u64)1 << 32) { x >>= 32; n += 32; }
-	if (x >= (u64)1 << 16) { x >>= 16; n += 16; }
+#endif
-	if (x >= (u64)1 <<  8) { x >>=  8; n +=  8; }
+	if (x >= (u32)1 << 16) { x >>= 16; n += 16; }
-	if (x >= (u64)1 <<  4) { x >>=  4; n +=  4; }
+	if (x >= (u32)1 <<  8) { x >>=  8; n +=  8; }
-	if (x >= (u64)1 <<  2) { x >>=  2; n +=  2; }
+	if (x >= (u32)1 <<  4) { x >>=  4; n +=  4; }
-	if (x >= (u64)1 <<  1) {           n +=  1; }
+	if (x >= (u32)1 <<  2) { x >>=  2; n +=  2; }
+	if (x >= (u32)1 <<  1) {           n +=  1; }
 #endif
 	return n;
 }
 
-inline cell log2(u16 x)
+inline cell rightmost_clear_bit(cell x)
-{
-#if defined(FACTOR_X86) || defined(FACTOR_AMD64)
-	cell n;
-	asm ("bsr %1, %0;":"=r"(n):"r"((cell)x));
-#else
-	cell n = 0;
-	if (x >= 1 << 8) { x >>=  8; n += 8; }
-	if (x >= 1 << 4) { x >>=  4; n += 4; }
-	if (x >= 1 << 2) { x >>=  2; n += 2; }
-	if (x >= 1 << 1) {           n += 1; }
-#endif
-	return n;
-}
-
-inline cell rightmost_clear_bit(u64 x)
 {
 	return log2(~x & (x + 1));
 }
 
-inline cell rightmost_set_bit(u64 x)
+inline cell rightmost_set_bit(cell x)
 {
 	return log2(x & -x);
 }
 
-inline cell rightmost_set_bit(u16 x)
-{
-	return log2((u16)(x & -x));
-}
-
 }

vm/bump_allocator.hpp

@@ -32,6 +32,23 @@ template<typename Block> struct bump_allocator {
 	{
 		return end - here;
 	}
+
+	cell next_object_after(cell scan)
+	{
+		cell size = ((Block *)scan)->size();
+		if(scan + size < here)
+			return scan + size;
+		else
+			return 0;
+	}
+
+	cell first_object()
+	{
+		if(start != here)
+			return start;
+		else
+			return 0;
+	}
 };
 
 }

vm/code_heap.cpp

@@ -118,10 +118,8 @@ struct word_and_literal_code_heap_updater {
 
 void factor_vm::update_code_heap_words_and_literals()
 {
-	current_gc->event->started_code_sweep();
 	word_and_literal_code_heap_updater updater(this);
-	code->allocator->sweep(updater);
+	iterate_code_heap(updater);
-	current_gc->event->ended_code_sweep();
 }
 
 /* After growing the heap, we have to perform a full relocation to update
@@ -137,12 +135,6 @@ struct code_heap_relocator {
 	}
 };
 
-void factor_vm::relocate_code_heap()
-{
-	code_heap_relocator relocator(this);
-	code->allocator->sweep(relocator);
-}
-
 void factor_vm::primitive_modify_code_heap()
 {
 	data_root<array> alist(dpop(),this);
@@ -152,8 +144,7 @@ void factor_vm::primitive_modify_code_heap()
 	if(count == 0)
 		return;
 
-	cell i;
+	for(cell i = 0; i < count; i++)
-	for(i = 0; i < count; i++)
 	{
 		data_root<array> pair(array_nth(alist.untagged(),i),this);
 

vm/compaction.cpp

@@ -150,9 +150,9 @@ struct object_code_block_updater {
 	explicit object_code_block_updater(code_block_visitor<forwarder<code_block> > *visitor_) :
 		visitor(visitor_) {}
 
-	void operator()(cell obj)
+	void operator()(object *obj)
 	{
-		visitor->visit_object_code_block(tagged<object>(obj).untagged());
+		visitor->visit_object_code_block(obj);
 	}
 };
 

vm/contexts.cpp

@@ -196,4 +196,12 @@ void factor_vm::primitive_check_datastack()
 	}
 }
 
+void factor_vm::primitive_load_locals()
+{
+	fixnum count = untag_fixnum(dpop());
+	memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);
+	ds -= sizeof(cell) * count;
+	rs += sizeof(cell) * count;
+}
+
 }

vm/data_heap.cpp

@@ -103,6 +103,12 @@ bool data_heap::low_memory_p()
 	return (tenured->free_space() <= nursery->size + aging->size);
 }
 
+void data_heap::mark_all_cards()
+{
+	memset(cards,-1,cards_end - cards);
+	memset(decks,-1,decks_end - decks);
+}
+
 void factor_vm::set_data_heap(data_heap *data_)
 {
 	data = data_;
@@ -115,15 +121,6 @@ void factor_vm::init_data_heap(cell young_size, cell aging_size, cell tenured_si
 	set_data_heap(new data_heap(young_size,aging_size,tenured_size));
 }
 
-/* Size of the object pointed to by a tagged pointer */
-cell factor_vm::object_size(cell tagged)
-{
-	if(immediate_p(tagged))
-		return 0;
-	else
-		return untag<object>(tagged)->size();
-}
-
 /* Size of the object pointed to by an untagged pointer */
 cell object::size() const
 {
@@ -201,11 +198,6 @@ cell object::binary_payload_start() const
 	}
 }
 
-void factor_vm::primitive_size()
-{
-	box_unsigned_cell(object_size(dpop()));
-}
-
 data_heap_room factor_vm::data_room()
 {
 	data_heap_room room;
@@ -234,82 +226,42 @@ void factor_vm::primitive_data_room()
 	dpush(tag<byte_array>(byte_array_from_value(&room)));
 }
 
-/* Disables GC and activates next-object ( -- obj ) primitive */
+struct object_accumulator {
-void factor_vm::begin_scan()
+	cell type;
+	std::vector<cell> objects;
+
+	explicit object_accumulator(cell type_) : type(type_) {}
+
+	void operator()(object *obj)
+	{
+		if(type == TYPE_COUNT || obj->h.hi_tag() == type)
+			objects.push_back(tag_dynamic(obj));
+	}
+};
+
+cell factor_vm::instances(cell type)
 {
-	heap_scan_ptr = data->tenured->first_object();
+	object_accumulator accum(type);
+	each_object(accum);
+	cell object_count = accum.objects.size();
+
 	gc_off = true;
-}
+	array *objects = allot_array(object_count,false_object);
-
+	memcpy(objects->data(),&accum.objects[0],object_count * sizeof(cell));
-void factor_vm::end_scan()
-{
 	gc_off = false;
+
+	return tag<array>(objects);
 }
 
-void factor_vm::primitive_begin_scan()
+void factor_vm::primitive_all_instances()
 {
-	begin_scan();
+	primitive_full_gc();
+	dpush(instances(TYPE_COUNT));
 }
 
-cell factor_vm::next_object()
-{
-	if(!gc_off)
-		general_error(ERROR_HEAP_SCAN,false_object,false_object,NULL);
-
-	if(heap_scan_ptr)
-	{
-		cell current = heap_scan_ptr;
-		heap_scan_ptr = data->tenured->next_object_after(heap_scan_ptr);
-		return tag_dynamic((object *)current);
-	}
-	else
-		return false_object;
-}
-
-/* Push object at heap scan cursor and advance; pushes f when done */
-void factor_vm::primitive_next_object()
-{
-	dpush(next_object());
-}
-
-/* Re-enables GC */
-void factor_vm::primitive_end_scan()
-{
-	gc_off = false;
-}
-
-struct word_counter {
-	cell count;
-
-	explicit word_counter() : count(0) {}
-
-	void operator()(cell obj)
-	{
-		if(tagged<object>(obj).type_p(WORD_TYPE))
-			count++;
-	}
-};
-
-struct word_accumulator {
-	growable_array words;
-
-	explicit word_accumulator(int count,factor_vm *vm) : words(vm,count) {}
-
-	void operator()(cell obj)
-	{
-		if(tagged<object>(obj).type_p(WORD_TYPE))
-			words.add(obj);
-	}
-};
-
 cell factor_vm::find_all_words()
 {
-	word_counter counter;
+	return instances(WORD_TYPE);
-	each_object(counter);
-	word_accumulator accum(counter.count,this);
-	each_object(accum);
-	accum.words.trim();
-	return accum.words.elements.value();
 }
 
 }

vm/data_heap.hpp

@@ -30,6 +30,7 @@ struct data_heap {
 	void reset_generation(aging_space *gen);
 	void reset_generation(tenured_space *gen);
 	bool low_memory_p();
+	void mark_all_cards();
 };
 
 struct data_heap_room {

vm/debug.cpp

@@ -241,12 +241,12 @@ struct object_dumper {
 	explicit object_dumper(factor_vm *parent_, cell type_) :
 		parent(parent_), type(type_) {}
 
-	void operator()(cell obj)
+	void operator()(object *obj)
 	{
-		if(type == TYPE_COUNT || tagged<object>(obj).type_p(type))
+		if(type == TYPE_COUNT || obj->h.hi_tag() == type)
 		{
-			std::cout << padded_address(obj) << " ";
+			std::cout << padded_address((cell)obj) << " ";
-			parent->print_nested_obj(obj,2);
+			parent->print_nested_obj(tag_dynamic(obj),2);
 			std::cout << std::endl;
 		}
 	}
@@ -260,18 +260,19 @@ void factor_vm::dump_objects(cell type)
 }
 
 struct data_reference_slot_visitor {
-	cell look_for, obj;
+	cell look_for;
+	object *obj;
 	factor_vm *parent;
 
-	explicit data_reference_slot_visitor(cell look_for_, cell obj_, factor_vm *parent_) :
+	explicit data_reference_slot_visitor(cell look_for_, object *obj_, factor_vm *parent_) :
 		look_for(look_for_), obj(obj_), parent(parent_) { }
 
 	void operator()(cell *scan)
 	{
 		if(look_for == *scan)
 		{
-			std::cout << padded_address(obj) << " ";
+			std::cout << padded_address((cell)obj) << " ";
-			parent->print_nested_obj(obj,2);
+			parent->print_nested_obj(tag_dynamic(obj),2);
 			std::cout << std::endl;
 		}
 	}
@@ -284,10 +285,10 @@ struct data_reference_object_visitor {
 	explicit data_reference_object_visitor(cell look_for_, factor_vm *parent_) :
 		look_for(look_for_), parent(parent_) {}
 
-	void operator()(cell obj)
+	void operator()(object *obj)
 	{
 		data_reference_slot_visitor visitor(look_for,obj,parent);
-		parent->do_slots(UNTAG(obj),visitor);
+		parent->do_slots(obj,visitor);
 	}
 };
 

vm/errors.hpp

@@ -13,7 +13,6 @@ enum vm_error_type
 	ERROR_ARRAY_SIZE,
 	ERROR_C_STRING,
 	ERROR_FFI,
-	ERROR_HEAP_SCAN,
 	ERROR_UNDEFINED_SYMBOL,
 	ERROR_DS_UNDERFLOW,
 	ERROR_DS_OVERFLOW,

vm/factor.cpp

@@ -86,6 +86,7 @@ void factor_vm::do_stage1_init()
 	fflush(stdout);
 
 	compile_all_words();
+	update_code_heap_words();
 	special_objects[OBJ_STAGE2] = true_object;
 
 	std::cout << "done\n";

vm/free_list_allocator.hpp

@@ -23,7 +23,6 @@ template<typename Block> struct free_list_allocator {
 	cell largest_free_block();
 	cell free_block_count();
 	void sweep();
-	template<typename Iterator> void sweep(Iterator &iter);
 	template<typename Iterator, typename Sizer> void compact(Iterator &iter, Sizer &sizer);
 	template<typename Iterator, typename Sizer> void iterate(Iterator &iter, Sizer &sizer);
 	template<typename Iterator> void iterate(Iterator &iter);
@@ -152,59 +151,6 @@ void free_list_allocator<Block>::sweep()
 	}
 }
 
-template<typename Block>
-template<typename Iterator>
-void free_list_allocator<Block>::sweep(Iterator &iter)
-{
-	free_blocks.clear_free_list();
-
-	Block *prev = NULL;
-	Block *scan = this->first_block();
-	Block *end = this->last_block();
-
-	while(scan != end)
-	{
-		cell size = scan->size();
-
-		if(scan->free_p())
-		{
-			if(prev && prev->free_p())
-			{
-				free_heap_block *free_prev = (free_heap_block *)prev;
-				free_prev->make_free(free_prev->size() + size);
-			}
-			else
-				prev = scan;
-		}
-		else if(this->state.marked_p(scan))
-		{
-			if(prev && prev->free_p())
-				free_blocks.add_to_free_list((free_heap_block *)prev);
-			prev = scan;
-			iter(scan,size);
-		}
-		else
-		{
-			if(prev && prev->free_p())
-			{
-				free_heap_block *free_prev = (free_heap_block *)prev;
-				free_prev->make_free(free_prev->size() + size);
-			}
-			else
-			{
-				free_heap_block *free_block = (free_heap_block *)scan;
-				free_block->make_free(size);
-				prev = scan;
-			}
-		}
-
-		scan = (Block *)((cell)scan + size);
-	}
-
-	if(prev && prev->free_p())
-		free_blocks.add_to_free_list((free_heap_block *)prev);
-}
-
 template<typename Block, typename Iterator> struct heap_compactor {
 	mark_bits<Block> *state;
 	char *address;

vm/full_collector.cpp

@@ -116,6 +116,10 @@ void factor_vm::collect_sweep_impl()
 	data->tenured->sweep();
 	update_code_roots_for_sweep();
 	current_gc->event->ended_data_sweep();
+
+	current_gc->event->started_code_sweep();
+	code->allocator->sweep();
+	current_gc->event->ended_code_sweep();
 }
 
 void factor_vm::collect_full(bool trace_contexts_p)

vm/gc.cpp

@@ -218,37 +218,6 @@ void factor_vm::primitive_compact_gc()
 		true /* trace contexts? */);
 }
 
-/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
-   to coalesce equal but distinct quotations and wrappers. */
-void factor_vm::primitive_become()
-{
-	array *new_objects = untag_check<array>(dpop());
-	array *old_objects = untag_check<array>(dpop());
-
-	cell capacity = array_capacity(new_objects);
-	if(capacity != array_capacity(old_objects))
-		critical_error("bad parameters to become",0);
-
-	cell i;
-
-	for(i = 0; i < capacity; i++)
-	{
-		tagged<object> old_obj(array_nth(old_objects,i));
-		tagged<object> new_obj(array_nth(new_objects,i));
-
-		if(old_obj != new_obj)
-			old_obj->h.forward_to(new_obj.untagged());
-	}
-
-	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
-	   by referencing the old quotation unless we recompile all
-	   unoptimized words. */
-	compile_all_words();
-}
-
 void factor_vm::inline_gc(cell *data_roots_base, cell data_roots_size)
 {
 	for(cell i = 0; i < data_roots_size; i++)
@@ -290,9 +259,7 @@ object *factor_vm::allot_large_object(header header, cell size)
 	/* Allows initialization code to store old->new pointers
 	without hitting the write barrier in the common case of
 	a nursery allocation */
-	char *start = (char *)obj;
+	write_barrier(obj,size);
-	for(cell offset = 0; offset < size; offset += card_size)
-		write_barrier((cell *)(start + offset));
 
 	obj->h = header;
 	return obj;

vm/image.cpp

@@ -154,7 +154,7 @@ void factor_vm::relocate_object(object *object,
 	else
 	{
 		object_fixupper fixupper(this,data_relocation_base);
-		do_slots((cell)object,fixupper);
+		do_slots(object,fixupper);
 
 		switch(hi_tag)
 		{

vm/mark_bits.hpp

@@ -2,18 +2,19 @@ namespace factor
 {
 
 const int block_granularity = 16;
-const int forwarding_granularity = 64;
+const int mark_bits_granularity = sizeof(cell) * 8;
+const int mark_bits_mask = sizeof(cell) * 8 - 1;
 
 template<typename Block> struct mark_bits {
 	cell size;
 	cell start;
 	cell bits_size;
-	u64 *marked;
+	cell *marked;
 	cell *forwarding;
 
 	void clear_mark_bits()
 	{
-		memset(marked,0,bits_size * sizeof(u64));
+		memset(marked,0,bits_size * sizeof(cell));
 	}
 
 	void clear_forwarding()
@@ -24,8 +25,8 @@ template<typename Block> struct mark_bits {
 	explicit mark_bits(cell size_, cell start_) :
 		size(size_),
 		start(start_),
-		bits_size(size / block_granularity / forwarding_granularity),
+		bits_size(size / block_granularity / mark_bits_granularity),
-		marked(new u64[bits_size]),
+		marked(new cell[bits_size]),
 		forwarding(new cell[bits_size])
 	{
 		clear_mark_bits();
@@ -53,15 +54,15 @@ template<typename Block> struct mark_bits {
 	std::pair<cell,cell> bitmap_deref(Block *address)
 	{
 		cell line_number = block_line(address);
-		cell word_index = (line_number >> 6);
+		cell word_index = (line_number / mark_bits_granularity);
-		cell word_shift = (line_number & 63);
+		cell word_shift = (line_number & mark_bits_mask);
 		return std::make_pair(word_index,word_shift);
 	}
 
-	bool bitmap_elt(u64 *bits, Block *address)
+	bool bitmap_elt(cell *bits, Block *address)
 	{
 		std::pair<cell,cell> position = bitmap_deref(address);
-		return (bits[position.first] & ((u64)1 << position.second)) != 0;
+		return (bits[position.first] & ((cell)1 << position.second)) != 0;
 	}
 
 	Block *next_block_after(Block *block)
@@ -69,13 +70,13 @@ template<typename Block> struct mark_bits {
 		return (Block *)((cell)block + block->size());
 	}
 
-	void set_bitmap_range(u64 *bits, Block *address)
+	void set_bitmap_range(cell *bits, Block *address)
 	{
 		std::pair<cell,cell> start = bitmap_deref(address);
 		std::pair<cell,cell> end = bitmap_deref(next_block_after(address));
 
-		u64 start_mask = ((u64)1 << start.second) - 1;
+		cell start_mask = ((cell)1 << start.second) - 1;
-		u64 end_mask = ((u64)1 << end.second) - 1;
+		cell end_mask = ((cell)1 << end.second) - 1;
 
 		if(start.first == end.first)
 			bits[start.first] |= start_mask ^ end_mask;
@@ -87,7 +88,7 @@ template<typename Block> struct mark_bits {
 			bits[start.first] |= ~start_mask;
 
 			for(cell index = start.first + 1; index < end.first; index++)
-				bits[index] = (u64)-1;
+				bits[index] = (cell)-1;
 
 			if(end_mask != 0)
 			{
@@ -121,7 +122,8 @@ template<typename Block> struct mark_bits {
 		}
 	}
 
-	/* We have the popcount for every 64 entries; look up and compute the rest */
+	/* We have the popcount for every mark_bits_granularity entries; look
+	up and compute the rest */
 	Block *forward_block(Block *original)
 	{
 #ifdef FACTOR_DEBUG
@@ -130,7 +132,7 @@ template<typename Block> struct mark_bits {
 		std::pair<cell,cell> position = bitmap_deref(original);
 
 		cell approx_popcount = forwarding[position.first];
-		u64 mask = ((u64)1 << position.second) - 1;
+		cell mask = ((cell)1 << position.second) - 1;
 
 		cell new_line_number = approx_popcount + popcount(marked[position.first] & mask);
 		Block *new_block = line_block(new_line_number);
@@ -147,13 +149,13 @@ template<typename Block> struct mark_bits {
 
 		for(cell index = position.first; index < bits_size; index++)
 		{
-			u64 mask = ((s64)marked[index] >> bit_index);
+			cell mask = ((fixnum)marked[index] >> bit_index);
 			if(~mask)
 			{
 				/* Found an unmarked block on this page.
 				Stop, it's hammer time */
 				cell clear_bit = rightmost_clear_bit(mask);
-				return line_block(index * 64 + bit_index + clear_bit);
+				return line_block(index * mark_bits_granularity + bit_index + clear_bit);
 			}
 			else
 			{
@@ -174,13 +176,13 @@ template<typename Block> struct mark_bits {
 
 		for(cell index = position.first; index < bits_size; index++)
 		{
-			u64 mask = (marked[index] >> bit_index);
+			cell mask = (marked[index] >> bit_index);
 			if(mask)
 			{
 				/* Found an marked block on this page.
 				Stop, it's hammer time */
 				cell set_bit = rightmost_set_bit(mask);
-				return line_block(index * 64 + bit_index + set_bit);
+				return line_block(index * mark_bits_granularity + bit_index + set_bit);
 			}
 			else
 			{

vm/master.hpp

@@ -44,6 +44,7 @@ namespace factor
 #include "segments.hpp"
 #include "contexts.hpp"
 #include "run.hpp"
+#include "objects.hpp"
 #include "profiler.hpp"
 #include "errors.hpp"
 #include "bignumint.hpp"

vm/object_start_map.cpp

@@ -79,11 +79,16 @@ void object_start_map::update_for_sweep(mark_bits<object> *state)
 {
 	for(cell index = 0; index < state->bits_size; index++)
 	{
-		u64 mask = state->marked[index];
+		cell mask = state->marked[index];
+#ifdef FACTOR_64
 		update_card_for_sweep(index * 4,      mask        & 0xffff);
 		update_card_for_sweep(index * 4 + 1, (mask >> 16) & 0xffff);
 		update_card_for_sweep(index * 4 + 2, (mask >> 32) & 0xffff);
 		update_card_for_sweep(index * 4 + 3, (mask >> 48) & 0xffff);
+#else
+		update_card_for_sweep(index * 2,      mask        & 0xffff);
+		update_card_for_sweep(index * 2 + 1, (mask >> 16) & 0xffff);
+#endif
 	}
 }
 

vm/objects.cpp

@@ -0,0 +1,138 @@
+#include "master.hpp"
+
+namespace factor
+{
+
+void factor_vm::primitive_special_object()
+{
+	fixnum e = untag_fixnum(dpeek());
+	drepl(special_objects[e]);
+}
+
+void factor_vm::primitive_set_special_object()
+{
+	fixnum e = untag_fixnum(dpop());
+	cell value = dpop();
+	special_objects[e] = value;
+}
+
+void factor_vm::primitive_set_slot()
+{
+	fixnum slot = untag_fixnum(dpop());
+	object *obj = untag<object>(dpop());
+	cell value = dpop();
+
+	cell *slot_ptr = &obj->slots()[slot];
+	*slot_ptr = value;
+	write_barrier(slot_ptr);
+}
+
+cell factor_vm::clone_object(cell obj_)
+{
+	data_root<object> obj(obj_,this);
+
+	if(immediate_p(obj.value()))
+		return obj.value();
+	else
+	{
+		cell size = object_size(obj.value());
+		object *new_obj = allot_object(header(obj.type()),size);
+		memcpy(new_obj,obj.untagged(),size);
+		return tag_dynamic(new_obj);
+	}
+}
+
+void factor_vm::primitive_clone()
+{
+	drepl(clone_object(dpeek()));
+}
+
+/* Size of the object pointed to by a tagged pointer */
+cell factor_vm::object_size(cell tagged)
+{
+	if(immediate_p(tagged))
+		return 0;
+	else
+		return untag<object>(tagged)->size();
+}
+
+void factor_vm::primitive_size()
+{
+	box_unsigned_cell(object_size(dpop()));
+}
+
+struct slot_become_visitor {
+	std::map<object *,object *> *become_map;
+
+	explicit slot_become_visitor(std::map<object *,object *> *become_map_) :
+		become_map(become_map_) {}
+
+	object *operator()(object *old)
+	{
+		std::map<object *,object *>::const_iterator iter = become_map->find(old);
+		if(iter != become_map->end())
+			return iter->second;
+		else
+			return old;
+	}
+};
+
+struct object_become_visitor {
+	slot_visitor<slot_become_visitor> *workhorse;
+
+	explicit object_become_visitor(slot_visitor<slot_become_visitor> *workhorse_) :
+		workhorse(workhorse_) {}
+
+	void operator()(object *obj)
+	{
+		workhorse->visit_slots(obj);
+	}
+};
+
+/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
+   to coalesce equal but distinct quotations and wrappers. */
+void factor_vm::primitive_become()
+{
+	array *new_objects = untag_check<array>(dpop());
+	array *old_objects = untag_check<array>(dpop());
+
+	cell capacity = array_capacity(new_objects);
+	if(capacity != array_capacity(old_objects))
+		critical_error("bad parameters to become",0);
+
+	/* Build the forwarding map */
+	std::map<object *,object *> become_map;
+
+	for(cell i = 0; i < capacity; i++)
+	{
+		tagged<object> old_obj(array_nth(old_objects,i));
+		tagged<object> new_obj(array_nth(new_objects,i));
+
+		if(old_obj != new_obj)
+			become_map[old_obj.untagged()] = new_obj.untagged();
+	}
+
+	/* Update all references to old objects to point to new objects */
+	slot_visitor<slot_become_visitor> workhorse(this,slot_become_visitor(&become_map));
+	workhorse.visit_roots();
+	workhorse.visit_contexts();
+
+	object_become_visitor object_visitor(&workhorse);
+	each_object(object_visitor);
+
+	/* Since we may have introduced old->new references, need to revisit
+	all objects on a minor GC. */
+	data->mark_all_cards();
+	primitive_minor_gc();
+
+	/* If a word's definition quotation was in old_objects and the
+	   quotation in new_objects is not compiled, we might leak memory
+	   by referencing the old quotation unless we recompile all
+	   unoptimized words. */
+	compile_all_words();
+
+	/* Update references to old objects in the code heap */
+	update_code_heap_words_and_literals();
+}
+
+}

vm/objects.hpp

@@ -0,0 +1,101 @@
+namespace factor
+{
+
+static const cell special_object_count = 70;
+
+enum special_object {
+	OBJ_NAMESTACK,            /* used by library only */
+	OBJ_CATCHSTACK,           /* used by library only, per-callback */
+
+	OBJ_CURRENT_CALLBACK = 2, /* used by library only, per-callback */
+	OBJ_WALKER_HOOK,          /* non-local exit hook, used by library only */
+	OBJ_CALLCC_1,             /* used to pass the value in callcc1 */
+
+	OBJ_BREAK            = 5, /* quotation called by throw primitive */
+	OBJ_ERROR,                /* a marker consed onto kernel errors */
+
+	OBJ_CELL_SIZE        = 7, /* sizeof(cell) */
+	OBJ_CPU,                  /* CPU architecture */
+	OBJ_OS,                   /* operating system name */
+
+	OBJ_ARGS            = 10, /* command line arguments */
+	OBJ_STDIN,                /* stdin FILE* handle */
+	OBJ_STDOUT,               /* stdout FILE* handle */
+
+	OBJ_IMAGE           = 13, /* image path name */
+	OBJ_EXECUTABLE,		  /* runtime executable path name */
+
+	OBJ_EMBEDDED 	    = 15, /* are we embedded in another app? */
+	OBJ_EVAL_CALLBACK,        /* used when Factor is embedded in a C app */
+	OBJ_YIELD_CALLBACK,       /* used when Factor is embedded in a C app */
+	OBJ_SLEEP_CALLBACK,       /* used when Factor is embedded in a C app */
+
+	OBJ_COCOA_EXCEPTION = 19, /* Cocoa exception handler quotation */
+
+	OBJ_BOOT            = 20, /* boot quotation */
+	OBJ_GLOBAL,               /* global namespace */
+
+	/* Quotation compilation in quotations.c */
+	JIT_PROLOG          = 23,
+	JIT_PRIMITIVE_WORD,
+	JIT_PRIMITIVE,
+	JIT_WORD_JUMP,
+	JIT_WORD_CALL,
+	JIT_WORD_SPECIAL,
+	JIT_IF_WORD,
+	JIT_IF,
+	JIT_EPILOG,
+	JIT_RETURN,
+	JIT_PROFILING,
+	JIT_PUSH_IMMEDIATE,
+	JIT_DIP_WORD,
+	JIT_DIP,
+	JIT_2DIP_WORD,
+	JIT_2DIP,
+	JIT_3DIP_WORD,
+	JIT_3DIP,
+	JIT_EXECUTE_WORD,
+	JIT_EXECUTE_JUMP,
+	JIT_EXECUTE_CALL,
+	JIT_DECLARE_WORD,
+
+	/* Callback stub generation in callbacks.c */
+	CALLBACK_STUB       = 45,
+
+	/* Polymorphic inline cache generation in inline_cache.c */
+	PIC_LOAD            = 47,
+	PIC_TAG,
+	PIC_TUPLE,
+	PIC_CHECK_TAG,
+	PIC_CHECK_TUPLE,
+	PIC_HIT,
+	PIC_MISS_WORD,
+	PIC_MISS_TAIL_WORD,
+
+	/* Megamorphic cache generation in dispatch.c */
+	MEGA_LOOKUP         = 57,
+	MEGA_LOOKUP_WORD,
+	MEGA_MISS_WORD,
+
+	OBJ_UNDEFINED       = 60, /* default quotation for undefined words */
+
+	OBJ_STDERR          = 61, /* stderr FILE* handle */
+
+	OBJ_STAGE2          = 62, /* have we bootstrapped? */
+
+	OBJ_CURRENT_THREAD  = 63,
+
+	OBJ_THREADS         = 64,
+	OBJ_RUN_QUEUE       = 65,
+	OBJ_SLEEP_QUEUE     = 66,
+};
+
+#define OBJ_FIRST_SAVE OBJ_BOOT
+#define OBJ_LAST_SAVE OBJ_STAGE2
+
+inline static bool save_env_p(cell i)
+{
+	return (i >= OBJ_FIRST_SAVE && i <= OBJ_LAST_SAVE);
+}
+
+}

vm/primitives.cpp

@@ -49,8 +49,8 @@ PRIMITIVE_FORWARD(float_greater)
 PRIMITIVE_FORWARD(float_greatereq)
 PRIMITIVE_FORWARD(word)
 PRIMITIVE_FORWARD(word_xt)
-PRIMITIVE_FORWARD(getenv)
+PRIMITIVE_FORWARD(special_object)
-PRIMITIVE_FORWARD(setenv)
+PRIMITIVE_FORWARD(set_special_object)
 PRIMITIVE_FORWARD(existsp)
 PRIMITIVE_FORWARD(minor_gc)
 PRIMITIVE_FORWARD(full_gc)
@@ -82,9 +82,7 @@ PRIMITIVE_FORWARD(set_string_nth_slow)
 PRIMITIVE_FORWARD(resize_array)
 PRIMITIVE_FORWARD(resize_string)
 PRIMITIVE_FORWARD(array)
-PRIMITIVE_FORWARD(begin_scan)
+PRIMITIVE_FORWARD(all_instances)
-PRIMITIVE_FORWARD(next_object)
-PRIMITIVE_FORWARD(end_scan)
 PRIMITIVE_FORWARD(size)
 PRIMITIVE_FORWARD(die)
 PRIMITIVE_FORWARD(fopen)
@@ -185,8 +183,8 @@ const primitive_type primitives[] = {
 	primitive_float_greatereq,
 	primitive_word,
 	primitive_word_xt,
-	primitive_getenv,
+	primitive_special_object,
-	primitive_setenv,
+	primitive_set_special_object,
 	primitive_existsp,
 	primitive_minor_gc,
 	primitive_full_gc,
@@ -244,9 +242,7 @@ const primitive_type primitives[] = {
 	primitive_resize_array,
 	primitive_resize_string,
 	primitive_array,
-	primitive_begin_scan,
+	primitive_all_instances,
-	primitive_next_object,
-	primitive_end_scan,
 	primitive_size,
 	primitive_die,
 	primitive_fopen,

vm/quotations.cpp

@@ -341,8 +341,6 @@ void factor_vm::compile_all_words()
 		update_word_xt(word.untagged());
 
 	}
-
-	update_code_heap_words();
 }
 
 /* Allocates memory */

vm/run.cpp

@@ -3,19 +3,6 @@
 namespace factor
 {
 
-void factor_vm::primitive_getenv()
-{
-	fixnum e = untag_fixnum(dpeek());
-	drepl(special_objects[e]);
-}
-
-void factor_vm::primitive_setenv()
-{
-	fixnum e = untag_fixnum(dpop());
-	cell value = dpop();
-	special_objects[e] = value;
-}
-
 void factor_vm::primitive_exit()
 {
 	exit(to_fixnum(dpop()));
@@ -31,43 +18,4 @@ void factor_vm::primitive_sleep()
 	sleep_micros(to_cell(dpop()));
 }
 
-void factor_vm::primitive_set_slot()
-{
-	fixnum slot = untag_fixnum(dpop());
-	object *obj = untag<object>(dpop());
-	cell value = dpop();
-
-	cell *slot_ptr = &obj->slots()[slot];
-	*slot_ptr = value;
-	write_barrier(slot_ptr);
-}
-
-void factor_vm::primitive_load_locals()
-{
-	fixnum count = untag_fixnum(dpop());
-	memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);
-	ds -= sizeof(cell) * count;
-	rs += sizeof(cell) * count;
-}
-
-cell factor_vm::clone_object(cell obj_)
-{
-	data_root<object> obj(obj_,this);
-
-	if(immediate_p(obj.value()))
-		return obj.value();
-	else
-	{
-		cell size = object_size(obj.value());
-		object *new_obj = allot_object(header(obj.type()),size);
-		memcpy(new_obj,obj.untagged(),size);
-		return tag_dynamic(new_obj);
-	}
-}
-
-void factor_vm::primitive_clone()
-{
-	drepl(clone_object(dpeek()));
-}
-
 }

vm/run.hpp

@@ -1,103 +1,4 @@
 namespace factor
 {
 
-static const cell special_object_count = 70;
-
-enum special_object {
-	OBJ_NAMESTACK,            /* used by library only */
-	OBJ_CATCHSTACK,           /* used by library only, per-callback */
-
-	OBJ_CURRENT_CALLBACK = 2, /* used by library only, per-callback */
-	OBJ_WALKER_HOOK,          /* non-local exit hook, used by library only */
-	OBJ_CALLCC_1,             /* used to pass the value in callcc1 */
-
-	OBJ_BREAK            = 5, /* quotation called by throw primitive */
-	OBJ_ERROR,                /* a marker consed onto kernel errors */
-
-	OBJ_CELL_SIZE        = 7, /* sizeof(cell) */
-	OBJ_CPU,                  /* CPU architecture */
-	OBJ_OS,                   /* operating system name */
-
-	OBJ_ARGS            = 10, /* command line arguments */
-	OBJ_STDIN,                /* stdin FILE* handle */
-	OBJ_STDOUT,               /* stdout FILE* handle */
-
-	OBJ_IMAGE           = 13, /* image path name */
-	OBJ_EXECUTABLE,		  /* runtime executable path name */
-
-	OBJ_EMBEDDED 	    = 15, /* are we embedded in another app? */
-	OBJ_EVAL_CALLBACK,        /* used when Factor is embedded in a C app */
-	OBJ_YIELD_CALLBACK,       /* used when Factor is embedded in a C app */
-	OBJ_SLEEP_CALLBACK,       /* used when Factor is embedded in a C app */
-
-	OBJ_COCOA_EXCEPTION = 19, /* Cocoa exception handler quotation */
-
-	OBJ_BOOT            = 20, /* boot quotation */
-	OBJ_GLOBAL,               /* global namespace */
-
-	/* Quotation compilation in quotations.c */
-	JIT_PROLOG          = 23,
-	JIT_PRIMITIVE_WORD,
-	JIT_PRIMITIVE,
-	JIT_WORD_JUMP,
-	JIT_WORD_CALL,
-	JIT_WORD_SPECIAL,
-	JIT_IF_WORD,
-	JIT_IF,
-	JIT_EPILOG,
-	JIT_RETURN,
-	JIT_PROFILING,
-	JIT_PUSH_IMMEDIATE,
-	JIT_DIP_WORD,
-	JIT_DIP,
-	JIT_2DIP_WORD,
-	JIT_2DIP,
-	JIT_3DIP_WORD,
-	JIT_3DIP,
-	JIT_EXECUTE_WORD,
-	JIT_EXECUTE_JUMP,
-	JIT_EXECUTE_CALL,
-	JIT_DECLARE_WORD,
-
-	/* Callback stub generation in callbacks.c */
-	CALLBACK_STUB       = 45,
-
-	/* Polymorphic inline cache generation in inline_cache.c */
-	PIC_LOAD            = 47,
-	PIC_TAG,
-	PIC_TUPLE,
-	PIC_CHECK_TAG,
-	PIC_CHECK_TUPLE,
-	PIC_HIT,
-	PIC_MISS_WORD,
-	PIC_MISS_TAIL_WORD,
-
-	/* Megamorphic cache generation in dispatch.c */
-	MEGA_LOOKUP         = 57,
-	MEGA_LOOKUP_WORD,
-	MEGA_MISS_WORD,
-
-	OBJ_UNDEFINED       = 60, /* default quotation for undefined words */
-
-	OBJ_STDERR          = 61, /* stderr FILE* handle */
-
-	OBJ_STAGE2          = 62, /* have we bootstrapped? */
-
-	OBJ_CURRENT_THREAD  = 63,
-
-	OBJ_THREADS         = 64,
-	OBJ_RUN_QUEUE       = 65,
-	OBJ_SLEEP_QUEUE     = 66,
-};
-
-#define OBJ_FIRST_SAVE OBJ_BOOT
-#define OBJ_LAST_SAVE OBJ_STAGE2
-
-inline static bool save_env_p(cell i)
-{
-	return (i >= OBJ_FIRST_SAVE && i <= OBJ_LAST_SAVE);
 }
-
-}
-
- 

vm/vm.hpp

@@ -40,10 +40,6 @@ struct factor_vm
 	unsigned int signal_fpu_status;
 	stack_frame *signal_callstack_top;
 
-	/* A heap walk allows useful things to be done, like finding all
-	   references to an object for debugging purposes. */
-	cell heap_scan_ptr;
-
 	/* GC is off during heap walking */
 	bool gc_off;
 
@@ -102,6 +98,7 @@ struct factor_vm
 	void primitive_set_datastack();
 	void primitive_set_retainstack();
 	void primitive_check_datastack();
+	void primitive_load_locals();
 
 	template<typename Iterator> void iterate_active_frames(Iterator &iter)
 	{
@@ -116,15 +113,18 @@ struct factor_vm
 	}
 
 	// run
-	void primitive_getenv();
-	void primitive_setenv();
 	void primitive_exit();
 	void primitive_micros();
 	void primitive_sleep();
 	void primitive_set_slot();
-	void primitive_load_locals();
+
+	// objects
+	void primitive_special_object();
+	void primitive_set_special_object();
+	cell object_size(cell tagged);
 	cell clone_object(cell obj_);
 	void primitive_clone();
+	void primitive_become();
 
 	// profiler
 	void init_profiler();
@@ -220,20 +220,30 @@ struct factor_vm
 	void primitive_data_room();
 	void begin_scan();
 	void end_scan();
-	void primitive_begin_scan();
+	cell instances(cell type);
-	cell next_object();
+	void primitive_all_instances();
-	void primitive_next_object();
-	void primitive_end_scan();
 	cell find_all_words();
-	cell object_size(cell tagged);
+
+	template<typename Generation, typename Iterator>
+	inline void each_object(Generation *gen, Iterator &iterator)
+	{
+		cell obj = gen->first_object();
+		while(obj)
+		{
+			iterator((object *)obj);
+			obj = gen->next_object_after(obj);
+		}
+	}
 
 	template<typename Iterator> inline void each_object(Iterator &iterator)
 	{
-		begin_scan();
+		gc_off = true;
-		cell obj;
+
-		while(to_boolean(obj = next_object()))
+		each_object(data->tenured,iterator);
-			iterator(obj);
+		each_object(data->aging,iterator);
-		end_scan();
+		each_object(data->nursery,iterator);
+
+		gc_off = false;
 	}
 
 	/* the write barrier must be called any time we are potentially storing a
@@ -244,6 +254,13 @@ struct factor_vm
 		*(char *)(decks_offset + ((cell)slot_ptr >> deck_bits)) = card_mark_mask;
 	}
 
+	inline void write_barrier(object *obj, cell size)
+	{
+		char *start = (char *)obj;
+		for(cell offset = 0; offset < size; offset += card_size)
+			write_barrier((cell *)(start + offset));
+	}
+
 	// gc
 	void end_gc();
 	void start_gc_again();
@@ -264,7 +281,6 @@ struct factor_vm
 	void primitive_minor_gc();
 	void primitive_full_gc();
 	void primitive_compact_gc();
-	void primitive_become();
 	void inline_gc(cell *data_roots_base, cell data_roots_size);
 	void primitive_enable_gc_events();
 	void primitive_disable_gc_events();
@@ -508,7 +524,6 @@ struct factor_vm
 	void jit_compile_word(cell word_, cell def_, bool relocate);
 	void update_code_heap_words();
 	void update_code_heap_words_and_literals();
-	void relocate_code_heap();
 	void primitive_modify_code_heap();
 	code_heap_room code_room();
 	void primitive_code_room();
@@ -568,11 +583,11 @@ struct factor_vm
 	/* 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
 	to some other object. */
-	template<typename Iterator> void do_slots(cell obj, Iterator &iter)
+	template<typename Iterator> void do_slots(object *obj, Iterator &iter)
 	{
-		cell scan = obj;
+		cell scan = (cell)obj;
-		cell payload_start = ((object *)obj)->binary_payload_start();
+		cell payload_start = obj->binary_payload_start();
-		cell end = obj + payload_start;
+		cell end = scan + payload_start;
 
 		scan += sizeof(cell);