Working on adding support for the new write barrier to optimized code

diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor
index 363cea7852d039b5ccf8698fd139f2bf52c995d4..b8735e224c3e6f8dd92485173a3418a4215aeb35 100644 (file)
--- a/basis/compiler/cfg/dce/dce.factor
+++ b/basis/compiler/cfg/dce/dce.factor
@@ -42,6 +42,9 @@ M: ##set-slot-imm build-liveness-graph
 M: ##write-barrier build-liveness-graph
     dup src>> setter-liveness-graph ;
 
+M: ##write-barrier-imm build-liveness-graph
+    dup src>> setter-liveness-graph ;
+
 M: ##allot build-liveness-graph
     [ dst>> allocations get conjoin ] [ call-next-method ] bi ;
 
@@ -74,6 +77,9 @@ M: ##set-slot-imm compute-live-vregs
 M: ##write-barrier compute-live-vregs
     dup src>> setter-live-vregs ;
 
+M: ##write-barrier-imm compute-live-vregs
+    dup src>> setter-live-vregs ;
+
 M: ##fixnum-add compute-live-vregs record-live ;
 
 M: ##fixnum-sub compute-live-vregs record-live ;
@@ -91,6 +97,8 @@ M: ##set-slot-imm live-insn? obj>> live-vreg? ;
 
 M: ##write-barrier live-insn? src>> live-vreg? ;
 
+M: ##write-barrier-imm live-insn? src>> live-vreg? ;
+
 M: ##fixnum-add live-insn? drop t ;
 
 M: ##fixnum-sub live-insn? drop t ;

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 119af6d0b1cb1d4fcc5eee4263e28902198ae413..bffa0e59d054eda3c20d2bc0636bc1b653d5fa13 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -619,8 +619,13 @@ literal: size class
 temp: temp/int-rep ;
 
 INSN: ##write-barrier
+use: src/int-rep slot/int-rep
+temp: temp1/int-rep temp2/int-rep ;
+
+INSN: ##write-barrier-imm
 use: src/int-rep
-temp: card#/int-rep table/int-rep ;
+literal: slot
+temp: temp1/int-rep temp2/int-rep ;
 
 INSN: ##alien-global
 def: dst/int-rep

diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor
index 8ee1c41cfbdd32ccdb74a01a078019a5c0ccd22b..a28c95f81f2a65068f40ed37b44fef8cdadfbddc 100644 (file)
--- a/basis/compiler/cfg/intrinsics/slots/slots.factor
+++ b/basis/compiler/cfg/intrinsics/slots/slots.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: layouts namespaces kernel accessors sequences classes.algebra
-compiler.tree.propagation.info compiler.cfg.stacks compiler.cfg.hats
+fry compiler.tree.propagation.info compiler.cfg.stacks compiler.cfg.hats
 compiler.cfg.registers compiler.cfg.instructions
 compiler.cfg.utilities compiler.cfg.builder.blocks ;
 IN: compiler.cfg.intrinsics.slots
@@ -30,25 +30,25 @@ IN: compiler.cfg.intrinsics.slots
         ds-push
     ] [ drop emit-primitive ] if ;
 
-: (emit-set-slot) ( infos -- obj-reg )
-    [ 3inputs ] [ second value-tag ] bi*
-    ^^tag-offset>slot over [ ##set-slot ] dip ;
+: (emit-set-slot) ( infos -- )
+    [ first class>> immediate class<= ]
+    [ [ 3inputs ] [ second value-tag ] bi* ^^tag-offset>slot ] bi
+    [ ##set-slot ]
+    [ '[ _ drop _ _ next-vreg next-vreg ##write-barrier ] unless ] 3bi ;
 
-: (emit-set-slot-imm) ( infos -- obj-reg )
+: (emit-set-slot-imm) ( infos -- )
     ds-drop
-    [ 2inputs ]
-    [ [ third literal>> ] [ second value-tag ] bi ] bi*
-    pick [ ##set-slot-imm ] dip ;
+    [ first class>> immediate class<= ]
+    [ [ 2inputs ] [ [ third literal>> ] [ second value-tag ] bi ] bi* ] bi
+    '[ _ ##set-slot-imm ]
+    [ '[ _ drop _ _ cells next-vreg next-vreg ##write-barrier-imm ] unless ] 3bi ;
 
 : emit-set-slot ( node -- )
     dup node-input-infos
     dup second value-tag [
         nip
-        [
-            dup third value-info-small-fixnum?
-            [ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
-        ] [ first class>> immediate class<= ] bi
-        [ drop ] [ next-vreg next-vreg ##write-barrier ] if
+        dup third value-info-small-fixnum?
+        [ (emit-set-slot-imm) ] [ (emit-set-slot) ] if
     ] [ drop emit-primitive ] if ;
 
 : emit-string-nth ( -- )

diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor
index 778d0526d52d7158578317973b54aa1dc4b764df..0217055923d025ef2d4821cd5c3b802ba6193c60 100644 (file)
--- a/basis/compiler/cfg/write-barrier/write-barrier.factor
+++ b/basis/compiler/cfg/write-barrier/write-barrier.factor
@@ -1,139 +1,43 @@
 ! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces assocs sets sequences
-fry combinators.short-circuit locals make arrays
-compiler.cfg
-compiler.cfg.dominance
-compiler.cfg.predecessors
-compiler.cfg.loop-detection
-compiler.cfg.rpo
-compiler.cfg.instructions 
-compiler.cfg.registers
-compiler.cfg.dataflow-analysis 
-compiler.cfg.utilities ;
+USING: accessors assocs combinators.short-circuit
+compiler.cfg.instructions compiler.cfg.rpo kernel namespaces
+sequences sets ;
 IN: compiler.cfg.write-barrier
 
-! Eliminate redundant write barrier hits.
+SYMBOL: fresh-allocations
 
-! Objects which have already been marked, as well as
-! freshly-allocated objects
-SYMBOL: safe
-
-! Objects which have been mutated
-SYMBOL: mutated
+SYMBOL: mutated-objects
 
 GENERIC: eliminate-write-barrier ( insn -- ? )
 
 M: ##allot eliminate-write-barrier
-    dst>> safe get conjoin t ;
+    dst>> fresh-allocations get conjoin t ;
 
-M: ##write-barrier eliminate-write-barrier
-    src>> dup safe get key? not
-    [ safe get conjoin t ] [ drop f ] if ;
+M: ##set-slot eliminate-write-barrier
+    obj>> mutated-objects get conjoin t ;
 
-M: insn eliminate-write-barrier drop t ;
+M: ##set-slot-imm eliminate-write-barrier
+    obj>> mutated-objects get conjoin t ;
 
-! This doesn't actually benefit from being a dataflow analysis
-! might as well be dominator-based
-! Dealing with phi functions would help, though
-FORWARD-ANALYSIS: safe
+: needs-write-barrier? ( insn -- ? )
+    { [ fresh-allocations get key? not ] [ mutated-objects get key? ] } 1&& ;
 
-: has-allocation? ( bb -- ? )
-    instructions>> [ { [ ##allocation? ] [ ##call? ] } 1|| ] any? ;
+M: ##write-barrier eliminate-write-barrier
+    src>> needs-write-barrier? ;
+
+M: ##write-barrier-imm eliminate-write-barrier
+    src>> needs-write-barrier? ;
 
-M: safe-analysis transfer-set
-    drop [ H{ } assoc-clone-like safe set ] dip
-    instructions>> [
-        eliminate-write-barrier drop
-    ] each safe get ;
+M: ##copy eliminate-write-barrier
+    "Run copy propagation first" throw ;
 
-M: safe-analysis join-sets
-    drop has-allocation? [ drop H{ } clone ] [ assoc-refine ] if ;
+M: insn eliminate-write-barrier drop t ;
 
 : write-barriers-step ( bb -- )
-    dup safe-in H{ } assoc-clone-like safe set
+    H{ } clone fresh-allocations set
+    H{ } clone mutated-objects set
     instructions>> [ eliminate-write-barrier ] filter-here ;
 
-GENERIC: remove-dead-barrier ( insn -- ? )
-
-M: ##write-barrier remove-dead-barrier
-    src>> mutated get key? ;
-
-M: ##set-slot remove-dead-barrier
-    obj>> mutated get conjoin t ;
-
-M: ##set-slot-imm remove-dead-barrier
-    obj>> mutated get conjoin t ;
-
-M: insn remove-dead-barrier drop t ;
-
-: remove-dead-barriers ( bb -- )
-    H{ } clone mutated set
-    instructions>> [ remove-dead-barrier ] filter-here ;
-
-! Availability of slot
-! Anticipation of this and set-slot would help too, maybe later
-FORWARD-ANALYSIS: slot
-
-UNION: access ##slot ##slot-imm ##set-slot ##set-slot-imm ;
-
-M: slot-analysis transfer-set
-    drop [ H{ } assoc-clone-like ] dip
-    instructions>> over '[
-        dup access? [
-            obj>> _ conjoin
-        ] [ drop ] if
-    ] each ;
-
-: slot-available? ( vreg bb -- ? )
-    slot-in key? ;
-
-: make-barriers ( vregs -- bb )
-    [ [ next-vreg next-vreg ##write-barrier ] each ] V{ } make <simple-block> ;
-
-: emit-barriers ( vregs loop -- )
-    swap [
-        [ [ header>> predecessors>> ] [ ends>> keys ] bi diff ]
-        [ header>> ] bi
-    ] [ make-barriers ] bi*
-    insert-basic-block ;
-
-: write-barriers ( bbs -- bb=>barriers )
-    [
-        dup instructions>>
-        [ ##write-barrier? ] filter
-        [ src>> ] map
-    ] { } map>assoc
-    [ nip empty? not ] assoc-filter ;
-
-: filter-dominant ( bb=>barriers bbs -- barriers )
-    '[ drop _ [ dominates? ] with all? ] assoc-filter
-    values concat prune ;
-
-: dominant-write-barriers ( loop -- vregs )
-    [ blocks>> values write-barriers ] [ ends>> keys ] bi filter-dominant ;
-
-: safe-loops ( -- loops )
-    loops get values
-    [ blocks>> keys [ has-allocation? not ] all? ] filter ;
-
-:: insert-extra-barriers ( cfg -- )
-    safe-loops [| loop |
-        cfg needs-dominance needs-predecessors drop
-        loop dominant-write-barriers
-        loop header>> '[ _ slot-available? ] filter
-        [ loop emit-barriers cfg cfg-changed drop ] unless-empty
-    ] each ;
-
-: contains-write-barrier? ( cfg -- ? )
-    post-order [ instructions>> [ ##write-barrier? ] any? ] any? ;
-
 : eliminate-write-barriers ( cfg -- cfg' )
-    dup contains-write-barrier? [
-        needs-loops
-        dup [ remove-dead-barriers ] each-basic-block
-        dup compute-slot-sets
-        dup insert-extra-barriers
-        dup compute-safe-sets
-        dup [ write-barriers-step ] each-basic-block
-    ] when ;
+    dup [ write-barriers-step ] each-basic-block ;

diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 938219af224d583ca25e6f1bd015476599e92d05..467e8d9b8dad58a0d6583b32fcc29fb50ee54d2b 100755 (executable)
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -218,6 +218,7 @@ CODEGEN: ##set-alien-double %set-alien-double
 CODEGEN: ##set-alien-vector %set-alien-vector
 CODEGEN: ##allot %allot
 CODEGEN: ##write-barrier %write-barrier
+CODEGEN: ##write-barrier-imm %write-barrier-imm
 CODEGEN: ##compare %compare
 CODEGEN: ##compare-imm %compare-imm
 CODEGEN: ##compare-float-ordered %compare-float-ordered

diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor
index 60dd055a5f6eb00343757309b589eeffd69f8626..f56d654c77a0df9fbfee97eb351bde5bfab752d4 100755 (executable)
--- a/basis/compiler/codegen/fixup/fixup.factor
+++ b/basis/compiler/codegen/fixup/fixup.factor
@@ -77,6 +77,15 @@ SYMBOL: relocation-table
 : rel-here ( offset class -- )
     [ add-literal ] dip rt-here rel-fixup ;
 
+: rel-vm ( class -- )
+    rt-vm rel-fixup ;
+
+: rel-cards-offset ( class -- )
+    rt-cards-offset rel-fixup ;
+
+: rel-decks-offset ( class -- )
+    rt-decks-offset rel-fixup ;
+
 ! And the rest
 : resolve-offset ( label-fixup -- offset )
     label>> offset>> [ "Unresolved label" throw ] unless* ;

diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index cc6003b89c2f66e044e01b92123d3da3c19242b8..f6c6573be145b9dba62395a720ebb5fc22042883 100644 (file)
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@@ -51,6 +51,8 @@ CONSTANT: rt-stack-chain 9
 CONSTANT: rt-untagged 10
 CONSTANT: rt-megamorphic-cache-hits 11
 CONSTANT: rt-vm 12
+CONSTANT: rt-cards-offset 13
+CONSTANT: rt-decks-offset 14
 
 : rc-absolute? ( n -- ? )
     ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 19b38fd8f8486b2d2ccdf69f8219651441ec9bcc..d5b84b70020ba95639fa99c5c99ebd9dd60a26cb 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -397,7 +397,8 @@ HOOK: %alien-global cpu ( dst symbol library -- )
 HOOK: %vm-field-ptr cpu ( dst fieldname -- )
 
 HOOK: %allot cpu ( dst size class temp -- )
-HOOK: %write-barrier cpu ( src card# table -- )
+HOOK: %write-barrier cpu ( src slot temp1 temp2 -- )
+HOOK: %write-barrier-imm cpu ( src slot temp1 temp2 -- )
 
 ! GC checks
 HOOK: %check-nursery cpu ( label size temp1 temp2 -- )

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 414249f88ebdfb96a6eb9a27420469bd14d3f9e4..55e9448c7cde62e43dd5038e9900249fc8679764 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -50,7 +50,7 @@ M: x86.32 reserved-area-size 0 ;
 M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
 
 : push-vm-ptr ( -- )
-    0 PUSH rc-absolute-cell rt-vm rel-fixup ; ! push the vm ptr as an argument
+    0 PUSH rc-absolute-cell rel-vm ; ! push the vm ptr as an argument
 
 M: x86.32 return-struct-in-registers? ( c-type -- ? )
     c-type
@@ -263,7 +263,7 @@ M: x86.32 %alien-callback ( quot -- )
     4 [
         EAX swap %load-reference
         EAX PUSH
-        param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup 
+        param-reg-2 %mov-vm-ptr
         "c_to_factor" f %alien-invoke
     ] with-aligned-stack ;
 
@@ -348,7 +348,7 @@ M:: x86.32 %call-gc ( gc-root-count temp -- )
     temp gc-root-base param@ LEA
     12 [
         ! Pass the VM ptr as the third parameter
-        0 PUSH rc-absolute-cell rt-vm rel-fixup
+        push-vm-ptr
         ! Pass number of roots as second parameter
         gc-root-count PUSH 
         ! Pass pointer to start of GC roots as first parameter

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 805dda982b004061eaeb714ffb002874326563da..c15169dd893fe5055a570faaf66d3a772ce63ced 100644 (file)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -75,9 +75,6 @@ M: x86.64 %prepare-unbox ( -- )
     param-reg-1 R14 [] MOV
     R14 cell SUB ;
 
-: %mov-vm-ptr ( reg -- )
-    0 MOV rc-absolute-cell rt-vm rel-fixup ;
-
 M:: x86.64 %unbox ( n rep func -- )
     param-reg-2 %mov-vm-ptr
     ! Call the unboxer
@@ -183,11 +180,11 @@ M: x86.64 %alien-invoke
     R11 CALL ;
 
 M: x86.64 %nest-stacks ( -- )
-    param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
+    param-reg-1 %mov-vm-ptr
     "nest_stacks" f %alien-invoke ;
 
 M: x86.64 %unnest-stacks ( -- )
-    param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
+    param-reg-1 %mov-vm-ptr
     "unnest_stacks" f %alien-invoke ;
 
 M: x86.64 %prepare-alien-indirect ( -- )

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 8612acdcff90e090474aea4e829cf01bfbba56c9..9b063d59e849060f9369d176323e4af6cbb92c2a 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -369,19 +369,17 @@ M: x86 %shl int-rep two-operand [ SHL ] emit-shift ;
 M: x86 %shr int-rep two-operand [ SHR ] emit-shift ;
 M: x86 %sar int-rep two-operand [ SAR ] emit-shift ;
 
-M: x86 %vm-field-ptr ( dst field -- )
-    [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
-    [ vm-field-offset ADD ] 2bi ;
+: %mov-vm-ptr ( reg -- )
+    0 MOV rc-absolute-cell rel-vm ;
 
-: load-zone-ptr ( reg -- )
-    #! Load pointer to start of zone array
-    "nursery" %vm-field-ptr ;
+M: x86 %vm-field-ptr ( dst field -- )
+    [ drop %mov-vm-ptr ] [ vm-field-offset ADD ] 2bi ;
 
 : load-allot-ptr ( nursery-ptr allot-ptr -- )
-    [ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
+    [ drop "nursery" %vm-field-ptr ] [ swap [] MOV ] 2bi ;
 
 : inc-allot-ptr ( nursery-ptr n -- )
-    [ cell [+] ] dip 8 align ADD ;
+    [ [] ] dip 8 align ADD ;
 
 : store-header ( temp class -- )
     [ [] ] [ type-number tag-fixnum ] bi* MOV ;
@@ -395,26 +393,32 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
     dst class store-tagged
     nursery-ptr size inc-allot-ptr ;
 
-M:: x86 %write-barrier ( src card# table -- )
-    #! Mark the card pointed to by vreg.
+:: (%write-barrier) ( src slot temp1 temp2 -- )
+    ! Compute slot address.
+    temp1 src MOV
+    temp1 slot ADD
+
     ! Mark the card
-    card# src MOV
-    card# card-bits SHR
-    table "cards_offset" %vm-field-ptr
-    table table [] MOV
-    table card# [+] card-mark <byte> MOV
+    temp1 card-bits SHR
+    temp2 0 MOV rc-absolute-cell rel-cards-offset
+    temp2 temp1 [+] card-mark <byte> MOV
 
     ! Mark the card deck
-    card# deck-bits card-bits - SHR
-    table "decks_offset" %vm-field-ptr
-    table table [] MOV
-    table card# [+] card-mark <byte> MOV ;
+    temp1 deck-bits card-bits - SHR
+    temp2 0 MOV rc-absolute-cell rel-decks-offset
+    temp2 temp1 [+] card-mark <byte> MOV ;
+
+M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ;
+
+M: x86 %write-barrier-imm ( src slot temp1 temp2 -- ) (%write-barrier) ;
 
 M:: x86 %check-nursery ( label size temp1 temp2 -- )
-    temp1 load-zone-ptr
-    temp2 temp1 cell [+] MOV
+    temp1 "nursery" %vm-field-ptr
+    ! Load 'here' into temp2
+    temp2 temp1 [] MOV
     temp2 size ADD
-    temp1 temp1 3 cells [+] MOV
+    ! Load 'end' into temp1
+    temp1 temp1 2 cells [+] MOV
     temp2 temp1 CMP
     label JLE ;
 
@@ -1327,8 +1331,8 @@ M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
-    temp1 temp1 "stack_chain" vm-field-offset [+] MOV
+    temp1 "stack_chain" %vm-field-ptr
+    temp1 temp1 [] MOV
     temp2 stack-reg cell neg [+] LEA
     temp1 [] temp2 MOV
     callback-allowed? [

diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index 24c68c90ce591aed3872b7642684f6b0eb65331b..f693f8e72c78160bda25772d8e280abf1e1bd2f9 100755 (executable)
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -41,6 +41,8 @@ int factor_vm::number_of_parameters(relocation_type type)
        case RT_STACK_CHAIN:
        case RT_MEGAMORPHIC_CACHE_HITS:
        case RT_VM:
+       case RT_CARDS_OFFSET:
+       case RT_DECKS_OFFSET:
                return 0;
        default:
                critical_error("Bad rel type",type);
@@ -180,6 +182,10 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
                return (cell)&megamorphic_cache_hits;
        case RT_VM:
                return (cell)this;
+       case RT_CARDS_OFFSET:
+               return cards_offset;
+       case RT_DECKS_OFFSET:
+               return decks_offset;
        default:
                critical_error("Bad rel type",rel);
                return 0; /* Can't happen */

diff --git a/vm/code_block.hpp b/vm/code_block.hpp
index ecdd22864f1c262e63618e3741fe2b4c6df4e9e0..e3d392001be590fa90afd817120dadcfbdfd1549 100644 (file)
--- a/vm/code_block.hpp
+++ b/vm/code_block.hpp
@@ -28,6 +28,10 @@ enum relocation_type {
        RT_MEGAMORPHIC_CACHE_HITS,
        /* address of vm object */
        RT_VM,
+       /* value of vm->cards_offset */
+       RT_CARDS_OFFSET,
+       /* value of vm->decks_offset */
+       RT_DECKS_OFFSET,
 };
 
 enum relocation_class {

diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp
index c79b8d4d310802fa80af169ba0c72a4bb2a431a5..56fd34bba0afa5bdadc71c44003634172675eec5 100644 (file)
--- a/vm/full_collector.cpp
+++ b/vm/full_collector.cpp
@@ -93,21 +93,49 @@ void full_collector::cheneys_algorithm()
        }
 }
 
-void factor_vm::collect_full(cell requested_bytes, bool trace_contexts_p)
+struct full_updater {
+       factor_vm *myvm;
+
+       full_updater(factor_vm *myvm_) : myvm(myvm_) {}
+
+       void operator()(heap_block *block)
+       {
+               myvm->relocate_code_block((code_block *)block);
+       }
+};
+
+struct literal_and_word_reference_updater {
+       factor_vm *myvm;
+
+       literal_and_word_reference_updater(factor_vm *myvm_) : myvm(myvm_) {}
+
+       void operator()(heap_block *block)
+       {
+               code_block *compiled = (code_block *)block;
+               myvm->update_literal_references(compiled);
+               myvm->update_word_references(compiled);
+       }
+};
+
+void factor_vm::free_unmarked_code_blocks(bool growing_data_heap)
 {
-       data_heap *old;
-       if(current_gc->growing_data_heap)
+       if(growing_data_heap)
        {
-               old = data;
-               set_data_heap(data->grow(requested_bytes));
+               full_updater updater(this);
+               code->free_unmarked(updater);
        }
        else
        {
-               old = NULL;
-               std::swap(data->tenured,data->tenured_semispace);
-               reset_generation(data->tenured);
+               literal_and_word_reference_updater updater(this);
+               code->free_unmarked(updater);
        }
 
+       code->points_to_nursery.clear();
+       code->points_to_aging.clear();
+}
+
+void factor_vm::collect_full_impl(bool trace_contexts_p)
+{
        full_collector collector(this);
 
        collector.trace_roots();
@@ -118,12 +146,26 @@ void factor_vm::collect_full(cell requested_bytes, bool trace_contexts_p)
        }
 
        collector.cheneys_algorithm();
-       free_unmarked_code_blocks();
 
        reset_generation(data->aging);
        nursery.here = nursery.start;
+}
 
-       if(old) delete old;
+void factor_vm::collect_growing_heap(cell requested_bytes, bool trace_contexts_p)
+{
+       data_heap *old = data;
+       set_data_heap(data->grow(requested_bytes));
+       collect_full(trace_contexts_p);
+       free_unmarked_code_blocks(true);
+       delete old;
+}
+
+void factor_vm::collect_full(bool trace_contexts_p)
+{
+       std::swap(data->tenured,data->tenured_semispace);
+       reset_generation(data->tenured);
+       collect_full_impl(trace_contexts_p);
+       free_unmarked_code_blocks(false);
 }
 
 }

diff --git a/vm/gc.cpp b/vm/gc.cpp
index 3b455b2a3f06e4b617e4f4e12721ce96ea969167..10aee9a736b171616e91da7b0fc5d7330f65a7b0 100755 (executable)
--- a/vm/gc.cpp
+++ b/vm/gc.cpp
@@ -12,27 +12,6 @@ gc_state::gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_ge
 
 gc_state::~gc_state() { }
 
-struct literal_and_word_reference_updater {
-       factor_vm *myvm;
-
-       literal_and_word_reference_updater(factor_vm *myvm_) : myvm(myvm_) {}
-
-       void operator()(heap_block *block)
-       {
-               code_block *compiled = (code_block *)block;
-               myvm->update_literal_references(compiled);
-               myvm->update_word_references(compiled);
-       }
-};
-
-void factor_vm::free_unmarked_code_blocks()
-{
-       literal_and_word_reference_updater updater(this);
-       code->free_unmarked(updater);
-       code->points_to_nursery.clear();
-       code->points_to_aging.clear();
-}
-
 void factor_vm::update_dirty_code_blocks(std::set<code_block *> *remembered_set)
 {
        /* The youngest generation that any code block can now reference */
@@ -75,6 +54,7 @@ void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_
                resort to growing the data heap */
                if(current_gc->collecting_tenured_p())
                {
+                       assert(!current_gc->growing_data_heap);
                        current_gc->growing_data_heap = true;
 
                        /* Since we start tracing again, any previously
@@ -105,7 +85,14 @@ void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_
                        collect_aging();
        }
         else if(current_gc->collecting_tenured_p())
-               collect_full(requested_bytes,trace_contexts_p);
+       {
+               if(current_gc->growing_data_heap)
+                       collect_growing_heap(requested_bytes,trace_contexts_p);
+               else
+                       collect_full(trace_contexts_p);
+       }
+       else
+               critical_error("Bug in GC",0);
 
        record_gc_stats();
 

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 135acd58ab40830684a2578a8694cbd5e67276c3..ae8e882b6b183e4a3835965a4f7fcff7bbfd71fa 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -232,12 +232,14 @@ struct factor_vm
        }
 
        // gc
-       void free_unmarked_code_blocks();
        void update_dirty_code_blocks(std::set<code_block *> *remembered_set);
        void collect_nursery();
        void collect_aging();
        void collect_to_tenured();
-       void collect_full(cell requested_bytes, bool trace_contexts_p);
+       void free_unmarked_code_blocks(bool growing_data_heap);
+       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 record_gc_stats();
        void garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts_p, cell requested_bytes);
        void gc();

diff --git a/vm/zone.hpp b/vm/zone.hpp
index 25859fe5007037c41a542e4e5a710304eec70947..4fe4ae9b6b5bcb1e2ab2a5abe91817f19574840d 100644 (file)
--- a/vm/zone.hpp
+++ b/vm/zone.hpp
@@ -2,14 +2,13 @@ namespace factor
 {
 
 struct zone {
-       /* allocation pointer is 'here'; its offset is hardcoded in the
-       compiler backends */
-       cell start;
+       /* offset of 'here' and 'end' is hardcoded in compiler backends */
        cell here;
-       cell size;
+       cell start;
        cell end;
+       cell size;
 
-       zone(cell size_, cell start_) : start(start_), here(0), size(size_), end(start_ + size_) {}
+       zone(cell size_, cell start_) : here(0), start(start_), end(start_ + size_), size(size_) {}
 
        inline bool contains_p(object *pointer)
        {