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

basis/bootstrap/image/image.factor

@@ -554,12 +554,19 @@ M: quotation '
 : fixup-header ( -- )
     heap-size data-heap-size-offset fixup ;
 
+: build-generics ( -- )
+    [
+        all-words
+        [ generic? ] filter
+        [ make-generic ] each
+    ] with-compilation-unit ;
+
 : build-image ( -- image )
     800000 <vector> image set
     20000 <hashtable> objects set
     emit-image-header t, 0, 1, -1,
     "Building generic words..." print flush
-    remake-generics
+    build-generics
     "Serializing words..." print flush
     emit-words
     "Serializing JIT data..." print flush

basis/combinators/smart/smart-tests.factor

@@ -53,3 +53,9 @@ IN: combinators.smart.tests
 { 2 0 } [ [ + ] nullary ] must-infer-as
 
 { 2 2 } [ [ [ + ] nullary ] preserving ] must-infer-as
+
+: smart-if-test ( a b -- b )
+    [ < ] [ swap - ] [ - ] smart-if ;
+
+[ 7 ] [ 10 3 smart-if-test ] unit-test
+[ 16 ] [ 25 41 smart-if-test ] unit-test

basis/combinators/smart/smart.factor

@@ -50,4 +50,4 @@ MACRO: nullary ( quot -- quot' )
     dup outputs '[ @ _ ndrop ] ;
 
 MACRO: smart-if ( pred true false -- )
-    '[ _ preserving _ _ if ] ; inline
+    '[ _ preserving _ _ if ] ;

basis/debugger/debugger.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2009 Slava Pestov.
+! Copyright (C) 2004, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: slots arrays definitions generic hashtables summary io kernel
 math namespaces make prettyprint prettyprint.config sequences assocs
@@ -252,6 +252,8 @@ M: decode-error summary drop "Character decoding error" ;
 
 M: bad-create summary drop "Bad parameters to create" ;
 
+M: cannot-be-inline summary drop "This type of word cannot be inlined" ;
+
 M: attempt-all-error summary drop "Nothing to attempt" ;
 
 M: already-disposed summary drop "Attempting to operate on disposed object" ;

basis/images/jpeg/jpeg.factor

@@ -287,7 +287,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
 : decode-macroblock ( -- blocks )
     jpeg> components>>
     [
-        [ mb-dim first2 * iota ]
+        [ mb-dim first2 * ]
         [ [ decode-block ] curry replicate ] bi
     ] map concat ;
 

basis/listener/listener.factor

@@ -193,13 +193,12 @@ SYMBOL: interactive-vocabs
 
 : with-interactive-vocabs ( quot -- )
     [
-        <manifest> manifest set
         "scratchpad" set-current-vocab
         interactive-vocabs get only-use-vocabs
         call
-    ] with-scope ; inline
+    ] with-manifest ; inline
 
 : listener ( -- )
-    [ [ { } (listener) ] with-interactive-vocabs ] with-return ;
+    [ [ { } (listener) ] with-return ] with-interactive-vocabs ;
 
 MAIN: listener

basis/macros/macros-tests.factor

@@ -21,3 +21,5 @@ unit-test
 
 [ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test
 
+[ ] [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ;" eval( -- ) ] unit-test
+    [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ; inline" eval( -- ) ] must-fail

basis/macros/macros.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser kernel sequences words effects combinators assocs
 definitions quotations namespaces memoize accessors
@@ -23,6 +23,8 @@ SYNTAX: MACRO: (:) define-macro ;
 
 PREDICATE: macro < word "macro" word-prop >boolean ;
 
+M: macro make-inline cannot-be-inline ;
+
 M: macro definer drop \ MACRO: \ ; ;
 
 M: macro definition "macro" word-prop ;

basis/math/ranges/ranges.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel layouts math math.order namespaces sequences
 sequences.private accessors classes.tuple arrays ;
@@ -16,10 +16,8 @@ M: range length ( seq -- n ) length>> ; inline
 
 M: range nth-unsafe ( n range -- obj ) [ step>> * ] keep from>> + ; inline
 
-! For ranges with many elements, the default element-wise methods
+! We want M\ tuple hashcode, not M\ sequence hashcode here!
-! sequences define are unsuitable because they're O(n)
+! sequences hashcode is O(n) in number of elements
-M: range equal? over range? [ tuple= ] [ 2drop f ] if ;
-
 M: range hashcode* tuple-hashcode ;
 
 INSTANCE: range immutable-sequence

basis/random/windows/windows.factor

@@ -1,7 +1,8 @@
 USING: accessors alien.c-types alien.data byte-arrays
 combinators.short-circuit continuations destructors init kernel
 locals namespaces random windows.advapi32 windows.errors
-windows.kernel32 windows.types math.bitwise ;
+windows.kernel32 windows.types math.bitwise sequences fry
+literals ;
 IN: random.windows
 
 TUPLE: windows-rng provider type ;
@@ -58,13 +59,23 @@ M: windows-rng random-bytes* ( n tuple -- bytes )
         [ CryptGenRandom win32-error=0/f ] keep
     ] with-destructors ;
 
-[
+ERROR: no-windows-crypto-provider error ;
-    MS_DEF_PROV
-    PROV_RSA_FULL <windows-rng> system-random-generator set-global
 
-    [ MS_STRONG_PROV PROV_RSA_FULL <windows-rng> ]
+: try-crypto-providers ( seq -- windows-rng )
-    [ drop MS_ENH_RSA_AES_PROV PROV_RSA_AES <windows-rng> ] recover
+    [ first2 <windows-rng> ] attempt-all
-    secure-random-generator set-global
+    dup windows-rng? [ no-windows-crypto-provider ] unless ;
+
+[
+    {
+        ${ MS_ENHANCED_PROV PROV_RSA_FULL }
+        ${ MS_DEF_PROV PROV_RSA_FULL }
+    } try-crypto-providers
+    system-random-generator set-global
+
+    {
+        ${ MS_STRONG_PROV PROV_RSA_FULL }
+        ${ MS_ENH_RSA_AES_PROV PROV_RSA_AES }
+    } try-crypto-providers secure-random-generator set-global
 ] "random.windows" add-startup-hook
 
 [

basis/vocabs/prettyprint/prettyprint.factor

@@ -64,12 +64,15 @@ M: rename pprint-qualified ( rename -- )
         tri
     ] with-pprint ;
 
+: filter-interesting ( seq -- seq' )
+    [ [ vocab? ] [ extra-words? ] bi or not ] filter ;
+
 PRIVATE>
 
 : (pprint-manifest ( manifest -- quots )
     [
         [ search-vocabs>> [ '[ _ pprint-using ] , ] unless-empty ]
-        [ qualified-vocabs>> [ extra-words? not ] filter [ '[ _ pprint-qualified ] , ] each ]
+        [ qualified-vocabs>> filter-interesting [ '[ _ pprint-qualified ] , ] each ]
         [ current-vocab>> [ '[ _ pprint-in ] , ] when* ]
         tri
     ] { } make ;

core/bootstrap/primitives.factor

@@ -31,32 +31,31 @@ architecture get {
 ! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
 
 ! Bring up a bare cross-compiling vocabulary.
-"syntax" vocab vocab-words bootstrap-syntax set {
+"syntax" vocab vocab-words bootstrap-syntax set
-    dictionary
+
-    new-classes
+H{ } clone dictionary set
-    changed-definitions changed-generics changed-effects
+H{ } clone root-cache set
-    outdated-generics forgotten-definitions
+H{ } clone source-files set
-    root-cache source-files update-map implementors-map
+H{ } clone update-map set
-} [ H{ } clone swap set ] each
+H{ } clone implementors-map set
 
 init-caches
 
+bootstrapping? on
+
+call( -- )
+call( -- )
+
 ! Vocabulary for slot accessors
 "accessors" create-vocab drop
 
-dummy-compiler compiler-impl set
-
-call( -- )
-call( -- )
-call( -- )
-
 ! After we execute bootstrap/layouts
 num-types get f <array> builtins set
 
-bootstrapping? on
-
 [
 
+call( -- )
+
 ! Create some empty vocabs where the below primitives and
 ! classes will go
 {

core/classes/tuple/tuple-tests.factor

@@ -6,7 +6,7 @@ io.streams.string kernel kernel.private math math.constants
 math.order namespaces parser parser.notes prettyprint
 quotations random see sequences sequences.private slots
 slots.private splitting strings summary threads tools.test
-vectors vocabs words words.symbol fry literals ;
+vectors vocabs words words.symbol fry literals memory ;
 IN: classes.tuple.tests
 
 TUPLE: rect x y w h ;
@@ -443,14 +443,14 @@ TUPLE: redefinition-problem-2 ;
 
 [ ] [
     [
-        \ vocab tuple { "xxx" } "slots" get append
+        \ vocab identity-tuple { "xxx" } "slots" get append
         define-tuple-class
     ] with-compilation-unit
 
     all-words drop
 
     [
-        \ vocab tuple "slots" get
+        \ vocab identity-tuple "slots" get
         define-tuple-class
     ] with-compilation-unit
 ] unit-test
@@ -765,3 +765,22 @@ USE: classes.struct
     [ "prototype" word-prop ] map
     [ '[ _ hashcode drop f ] [ drop t ] recover ] filter
 ] unit-test
+
+! Make sure that tuple reshaping updates code heap roots
+TUPLE: code-heap-ref ;
+
+: code-heap-ref' ( -- a ) T{ code-heap-ref } ;
+
+! Push foo's literal to tenured space
+[ ] [ gc ] unit-test
+
+! Reshape!
+[ ] [ "IN: classes.tuple.tests USE: math TUPLE: code-heap-ref { x integer initial: 5 } ;" eval( -- ) ] unit-test
+
+! Code heap reference
+[ t ] [ code-heap-ref' code-heap-ref? ] unit-test
+[ 5 ] [ code-heap-ref' x>> ] unit-test
+
+! Data heap reference
+[ t ] [ \ code-heap-ref' def>> first code-heap-ref? ] unit-test
+[ 5 ] [ \ code-heap-ref' def>> first x>> ] unit-test

core/compiler/units/units.factor

@@ -64,16 +64,6 @@ M: f process-forgotten-words drop ;
 : without-optimizer ( quot -- )
     [ f compiler-impl ] dip with-variable ; inline
 
-! Trivial compiler. We don't want to touch the code heap
-! during stage1 bootstrap, it would just waste time.
-SINGLETON: dummy-compiler
-
-M: dummy-compiler to-recompile f ;
-
-M: dummy-compiler recompile drop { } ;
-
-M: dummy-compiler process-forgotten-words drop ;
-
 : <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
 
 SYMBOL: definition-observers
@@ -143,13 +133,15 @@ M: object bump-effect-counter* drop f ;
     [ drop ] [ notify-definition-observers notify-error-observers ] if ;
 
 : finish-compilation-unit ( -- )
+    [ ] [
         remake-generics
         to-recompile recompile
         update-tuples
         process-forgotten-definitions
         modify-code-heap
         bump-effect-counter
-    notify-observers ;
+        notify-observers
+    ] if-bootstrapping ;
 
 PRIVATE>
 

core/generic/single/single-tests.factor

@@ -282,3 +282,6 @@ M: growable call-next-hooker call-next-method "growable " prepend ;
 [ "IN: generic.single.tests GENERIC# broken-generic# -1 ( a -- b )" eval( -- ) ]
 [ error>> bad-dispatch-position? ]
 must-fail-with
+
+[ ] [ "IN: generic.single.tests GENERIC: foo ( -- x )" eval( -- ) ] unit-test
+    [ "IN: generic.single.tests GENERIC: foo ( -- x ) inline" eval( -- ) ] must-fail

core/generic/single/single.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs classes classes.algebra
 combinators definitions generic hashtables kernel
@@ -16,6 +16,8 @@ TUPLE: single-combination ;
 PREDICATE: single-generic < generic
     "combination" word-prop single-combination? ;
 
+M: single-generic make-inline cannot-be-inline ;
+
 GENERIC: dispatch# ( word -- n )
 
 M: generic dispatch# "combination" word-prop dispatch# ;

core/parser/parser.factor

@@ -111,11 +111,10 @@ SYMBOL: bootstrap-syntax
 
 : with-file-vocabs ( quot -- )
     [
-        <manifest> manifest set
         "syntax" use-vocab
         bootstrap-syntax get [ use-words ] when*
         call
-    ] with-scope ; inline
+    ] with-manifest ; inline
 
 SYMBOL: print-use-hook
 

core/source-files/source-files.factor

@@ -16,7 +16,8 @@ checksum
 definitions ;
 
 : record-top-level-form ( quot file -- )
-    (>>top-level-form) H{ } notify-definition-observers ;
+    (>>top-level-form)
+    [ ] [ H{ } notify-definition-observers ] if-bootstrapping ;
 
 : record-checksum ( lines source-file -- )
     [ crc32 checksum-lines ] dip (>>checksum) ;

core/vocabs/parser/parser-tests.factor

@@ -1,5 +1,6 @@
 IN: vocabs.parser.tests
-USING: vocabs.parser tools.test eval kernel accessors ;
+USING: vocabs.parser tools.test eval kernel accessors definitions
+compiler.units words vocabs ;
 
 [ "FROM: kernel => doesnotexist ;" eval( -- ) ]
 [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ]
@@ -8,3 +9,43 @@ must-fail-with
 [ "RENAME: doesnotexist kernel => newname" eval( -- ) ]
 [ error>> T{ no-word-in-vocab { word "doesnotexist" } { vocab "kernel" } } = ]
 must-fail-with
+
+: aaa ( -- ) ;
+
+[
+    [ ] [ "aaa" "vocabs.parser.tests" "uutt" add-renamed-word ] unit-test
+
+    [ ] [ "vocabs.parser.tests" dup add-qualified ] unit-test
+
+    [ aaa ] [ "uutt" search ] unit-test
+    [ aaa ] [ "vocabs.parser.tests:aaa" search ] unit-test
+
+    [ ] [ [ "bbb" "vocabs.parser.tests" create drop ] with-compilation-unit ] unit-test
+
+    [ "bbb" ] [ "vocabs.parser.tests:bbb" search name>> ] unit-test
+
+    [ ] [ [ \ aaa forget ] with-compilation-unit ] unit-test
+
+    [ ] [ [ "bbb" "vocabs.parser.tests" lookup forget ] with-compilation-unit ] unit-test
+
+    [ f ] [ "uutt" search ] unit-test
+
+    [ f ] [ "vocabs.parser.tests:aaa" search ] unit-test
+
+    [ ] [ "vocabs.parser.tests.foo" set-current-vocab ] unit-test
+
+    [ ] [ [ "bbb" current-vocab create drop ] with-compilation-unit ] unit-test
+    
+    [ t ] [ "bbb" search >boolean ] unit-test
+
+    [ ] [ [ "vocabs.parser.tests.foo" forget-vocab ] with-compilation-unit ] unit-test
+    
+    [ [ "bbb" current-vocab create drop ] with-compilation-unit ] [ error>> no-current-vocab? ] must-fail-with
+
+    [ begin-private ] [ error>> no-current-vocab? ] must-fail-with
+
+    [ end-private ] [ error>> no-current-vocab? ] must-fail-with
+
+    [ f ] [ "bbb" search >boolean ] unit-test
+    
+] with-manifest

core/vocabs/parser/parser.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2007, 2009 Daniel Ehrenberg, Bruno Deferrari,
+! Copyright (C) 2007, 2010 Daniel Ehrenberg, Bruno Deferrari,
 ! Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs hashtables kernel namespaces sequences
 sets strings vocabs sorting accessors arrays compiler.units
-combinators vectors splitting continuations math
+combinators vectors splitting continuations math words
 parser.notes ;
 IN: vocabs.parser
 
@@ -26,7 +26,6 @@ current-vocab
 { search-vocab-names hashtable }
 { search-vocabs vector }
 { qualified-vocabs vector }
-{ extra-words vector }
 { auto-used vector } ;
 
 : <manifest> ( -- manifest )
@@ -34,7 +33,6 @@ current-vocab
         H{ } clone >>search-vocab-names
         V{ } clone >>search-vocabs
         V{ } clone >>qualified-vocabs
-        V{ } clone >>extra-words
         V{ } clone >>auto-used ;
 
 M: manifest clone
@@ -42,7 +40,6 @@ M: manifest clone
         [ clone ] change-search-vocab-names
         [ clone ] change-search-vocabs
         [ clone ] change-qualified-vocabs
-        [ clone ] change-extra-words
         [ clone ] change-auto-used ;
 
 TUPLE: extra-words words ;
@@ -69,10 +66,16 @@ ERROR: no-word-in-vocab word vocab ;
 : (from) ( vocab words -- vocab words words' vocab )
     2dup swap load-vocab ;
 
-: extract-words ( seq vocab -- assoc' )
+: extract-words ( seq vocab -- assoc )
     [ words>> extract-keys dup ] [ name>> ] bi
     [ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ;
 
+: excluding-words ( seq vocab -- assoc )
+    [ nip words>> ] [ extract-words ] 2bi assoc-diff ;
+
+: qualified-words ( prefix vocab -- assoc )
+    words>> swap [ swap [ swap ":" glue ] dip ] curry assoc-map ;
+
 : (lookup) ( name assoc -- word/f )
     at dup forward-reference? [ drop f ] when ;
 
@@ -83,8 +86,7 @@ PRIVATE>
 
 : set-current-vocab ( name -- )
     create-vocab
-    [ manifest get (>>current-vocab) ]
+    [ manifest get (>>current-vocab) ] [ (add-qualified) ] bi ;
-    [ words>> <extra-words> (add-qualified) ] bi ;
 
 : with-current-vocab ( name quot -- )
     manifest get clone manifest [
@@ -102,11 +104,11 @@ TUPLE: no-current-vocab ;
     manifest get current-vocab>> [ no-current-vocab ] unless* ;
 
 : begin-private ( -- )
-    manifest get current-vocab>> vocab-name ".private" ?tail
+    current-vocab name>> ".private" ?tail
     [ drop ] [ ".private" append set-current-vocab ] if ;
 
 : end-private ( -- )
-    manifest get current-vocab>> vocab-name ".private" ?tail
+    current-vocab name>> ".private" ?tail
     [ set-current-vocab ] [ drop ] if ;
 
 : using-vocab? ( vocab -- ? )
@@ -137,10 +139,7 @@ TUPLE: no-current-vocab ;
 TUPLE: qualified vocab prefix words ;
 
 : <qualified> ( vocab prefix -- qualified )
-    2dup
+    (from) qualified-words qualified boa ;
-    [ load-vocab words>> ] [ CHAR: : suffix ] bi*
-    [ swap [ prepend ] dip ] curry assoc-map
-    qualified boa ;
 
 : add-qualified ( vocab prefix -- )
     <qualified> (add-qualified) ;
@@ -156,7 +155,7 @@ TUPLE: from vocab names words ;
 TUPLE: exclude vocab names words ;
 
 : <exclude> ( vocab words -- from )
-    (from) [ nip words>> ] [ extract-words ] 2bi assoc-diff exclude boa ;
+    (from) excluding-words exclude boa ;
 
 : add-words-excluding ( vocab words -- )
     <exclude> (add-qualified) ;
@@ -207,3 +206,45 @@ PRIVATE>
 
 : search ( name -- word/f )
     manifest get search-manifest ;
+
+<PRIVATE
+
+GENERIC: update ( search-path-elt -- valid? )
+
+: trim-forgotten ( qualified-vocab -- valid? )
+    [ [ nip "forgotten" word-prop not ] assoc-filter ] change-words
+    words>> assoc-empty? not ;
+
+M: from update trim-forgotten ;
+M: rename update trim-forgotten ;
+M: extra-words update trim-forgotten ;
+M: exclude update trim-forgotten ;
+
+M: qualified update
+    dup vocab>> vocab [
+        dup [ prefix>> ] [ vocab>> load-vocab ] bi qualified-words
+        >>words
+    ] [ drop f ] if ;
+
+M: vocab update dup name>> vocab eq? ;
+
+: update-manifest ( manifest -- )
+    [ dup [ name>> vocab ] when ] change-current-vocab
+    [ [ drop vocab ] assoc-filter ] change-search-vocab-names
+    dup search-vocab-names>> keys [ vocab ] V{ } map-as >>search-vocabs
+    qualified-vocabs>> [ update ] filter! drop ;
+
+M: manifest definitions-changed ( assoc manifest -- )
+    nip update-manifest ;
+
+PRIVATE>
+
+: with-manifest ( quot -- )
+    <manifest> manifest [
+        [ call ] [
+            [ manifest get add-definition-observer call ]
+            [ manifest get remove-definition-observer ]
+            [ ]
+            cleanup
+        ] if-bootstrapping
+    ] with-variable ; inline

core/words/words.factor

@@ -87,7 +87,11 @@ M: word subwords drop f ;
 : make-deprecated ( word -- )
     t "deprecated" set-word-prop ;
 
-: make-inline ( word -- )
+ERROR: cannot-be-inline word ;
+
+GENERIC: make-inline ( word -- )
+
+M: word make-inline
     dup inline? [ drop ] [
         [ t "inline" set-word-prop ]
         [ changed-effect ]
@@ -155,7 +159,12 @@ ERROR: bad-create name vocab ;
 
 : create ( name vocab -- word )
     check-create 2dup lookup
-    dup [ 2nip ] [ drop vocab-name <word> dup reveal ] if ;
+    dup [ 2nip ] [
+        drop
+        vocab-name <word>
+        dup reveal
+        dup changed-definition
+    ] if ;
 
 : constructor-word ( name vocab -- word )
     [ "<" ">" surround ] dip create ;

vm/objects.cpp

@@ -110,6 +110,31 @@ struct object_become_visitor {
 	}
 };
 
+struct code_block_become_visitor {
+	slot_visitor<slot_become_visitor> *workhorse;
+
+	explicit code_block_become_visitor(slot_visitor<slot_become_visitor> *workhorse_) :
+		workhorse(workhorse_) {}
+
+	void operator()(code_block *compiled, cell size)
+	{
+		workhorse->visit_code_block_objects(compiled);
+		workhorse->visit_embedded_literals(compiled);
+	}
+};
+
+struct code_block_write_barrier_visitor {
+	code_heap *code;
+
+	explicit code_block_write_barrier_visitor(code_heap *code_) :
+		code(code_) {}
+
+	void operator()(code_block *compiled, cell size)
+	{
+		code->write_barrier(compiled);
+	}
+};
+
 /* 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()
@@ -134,6 +159,7 @@ void factor_vm::primitive_become()
 	}
 
 	/* 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();
@@ -141,10 +167,18 @@ void factor_vm::primitive_become()
 		object_become_visitor object_visitor(&workhorse);
 		each_object(object_visitor);
 
+		code_block_become_visitor code_block_visitor(&workhorse);
+		each_code_block(code_block_visitor);
+	}
+
 	/* Since we may have introduced old->new references, need to revisit
-	all objects on a minor GC. */
+	all objects and code blocks on a minor GC. */
 	data->mark_all_cards();
-	primitive_minor_gc();
+
+	{
+		code_block_write_barrier_visitor code_block_visitor(code);
+		each_code_block(code_block_visitor);
+	}
 }
 
 }