From 7d97c1922714399e8f6e804cbd7d25eeef9928c4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 15 Oct 2009 02:40:23 -0500
Subject: [PATCH 1/8] compiler: tweak ##write-barrier-imm

---
 .../cfg/intrinsics/slots/slots.factor         | 42 ++++++++++++-------
 basis/compiler/constants/constants.factor     | 26 ++++++------
 basis/cpu/x86/x86.factor                      |  5 +--
 3 files changed, 44 insertions(+), 29 deletions(-)

diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor
index a28c95f81f..8a86c984fe 100644
--- a/basis/compiler/cfg/intrinsics/slots/slots.factor
+++ b/basis/compiler/cfg/intrinsics/slots/slots.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: layouts namespaces kernel accessors sequences classes.algebra
-fry compiler.tree.propagation.info compiler.cfg.stacks compiler.cfg.hats
-compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.utilities compiler.cfg.builder.blocks ;
+USING: layouts namespaces kernel accessors sequences
+classes.algebra locals compiler.tree.propagation.info
+compiler.cfg.stacks compiler.cfg.hats compiler.cfg.registers
+compiler.cfg.instructions compiler.cfg.utilities
+compiler.cfg.builder.blocks compiler.constants ;
 IN: compiler.cfg.intrinsics.slots
 
 : value-tag ( info -- n ) class>> class-tag ; inline
@@ -30,18 +31,31 @@ IN: compiler.cfg.intrinsics.slots
         ds-push
     ] [ drop emit-primitive ] if ;
 
-: (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-write-barrier? ( infos -- ? )
+    first class>> immediate class<= not ;
 
-: (emit-set-slot-imm) ( infos -- )
+:: (emit-set-slot) ( infos -- )
+    3inputs :> slot :> obj :> src
+
+    slot infos second value-tag ^^tag-offset>slot :> slot
+
+    src obj slot ##set-slot
+
+    infos emit-write-barrier?
+    [ obj slot next-vreg next-vreg ##write-barrier ] when ;
+
+:: (emit-set-slot-imm) ( infos -- )
     ds-drop
-    [ 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 ;
+
+    2inputs :> obj :> src
+
+    infos third literal>> :> slot
+    infos second value-tag :> tag
+
+    src obj slot tag ##set-slot-imm
+
+    infos emit-write-barrier?
+    [ obj slot tag slot-offset next-vreg next-vreg ##write-barrier-imm ] when ;
 
 : emit-set-slot ( node -- )
     dup node-input-infos
diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index f6c6573be1..a22d522809 100644
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@@ -10,19 +10,21 @@ CONSTANT: deck-bits 18
 : card-mark ( -- n ) HEX: 40 HEX: 80 bitor ; inline
 
 ! These constants must match vm/layouts.h
-: header-offset ( -- n ) object tag-number neg ; inline
+: slot-offset ( slot tag -- n ) [ bootstrap-cells ] dip - ; inline
+
+: header-offset ( -- n ) 0 object tag-number slot-offset ; inline
 : float-offset ( -- n ) 8 float tag-number - ; inline
-: string-offset ( -- n ) 4 bootstrap-cells string tag-number - ; inline
-: string-aux-offset ( -- n ) 2 bootstrap-cells string tag-number - ; inline
-: profile-count-offset ( -- n ) 8 bootstrap-cells \ word tag-number - ; inline
-: byte-array-offset ( -- n ) 2 bootstrap-cells byte-array tag-number - ; inline
-: alien-offset ( -- n ) 3 bootstrap-cells alien tag-number - ; inline
-: underlying-alien-offset ( -- n ) bootstrap-cell alien tag-number - ; inline
-: tuple-class-offset ( -- n ) bootstrap-cell tuple tag-number - ; inline
-: word-xt-offset ( -- n ) 10 bootstrap-cells \ word tag-number - ; inline
-: quot-xt-offset ( -- n ) 4 bootstrap-cells quotation tag-number - ; inline
-: word-code-offset ( -- n ) 11 bootstrap-cells \ word tag-number - ; inline
-: array-start-offset ( -- n ) 2 bootstrap-cells array tag-number - ; inline
+: string-offset ( -- n ) 4 string tag-number slot-offset ; inline
+: string-aux-offset ( -- n ) 2 string tag-number slot-offset ; inline
+: profile-count-offset ( -- n ) 8 \ word tag-number slot-offset ; inline
+: byte-array-offset ( -- n ) 2 byte-array tag-number slot-offset ; inline
+: alien-offset ( -- n ) 3 alien tag-number slot-offset ; inline
+: underlying-alien-offset ( -- n ) 1 alien tag-number slot-offset ; inline
+: tuple-class-offset ( -- n ) 1 tuple tag-number slot-offset ; inline
+: word-xt-offset ( -- n ) 10 \ word tag-number slot-offset ; inline
+: quot-xt-offset ( -- n ) 4 quotation tag-number slot-offset ; inline
+: word-code-offset ( -- n ) 11 \ word tag-number slot-offset ; inline
+: array-start-offset ( -- n ) 2 array tag-number slot-offset ; inline
 : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
 
 ! Relocation classes
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 4a3545a5ba..af2d75f02d 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -93,7 +93,7 @@ M: x86 %return ( -- ) 0 RET ;
     0 <repetition> % ;
 
 :: (%slot-imm) ( obj slot tag -- op )
-    obj slot cells tag - [+] ; inline
+    obj slot tag slot-offset [+] ; inline
 
 M: x86 %slot ( dst obj slot -- ) [+] MOV ;
 M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ;
@@ -395,8 +395,7 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
 
 :: (%write-barrier) ( src slot temp1 temp2 -- )
     ! Compute slot address.
-    temp1 src MOV
-    temp1 slot ADD
+    temp1 src slot [+] LEA
 
     ! Mark the card
     temp1 card-bits SHR

From 2efc7d1b9e14e730cfdd7dde19626f0e6793c000 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 15 Oct 2009 04:47:54 -0500
Subject: [PATCH 2/8] cpu.ppc.bootstrap: update for JIT relocation changes

---
 basis/cpu/ppc/bootstrap.factor | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor
index b9e374f0bb..80c0124039 100644
--- a/basis/cpu/ppc/bootstrap.factor
+++ b/basis/cpu/ppc/bootstrap.factor
@@ -255,7 +255,7 @@ CONSTANT: rs-reg 14
 [
     3 ds-reg 0 LWZ
     ds-reg dup 4 SUBI
-    4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel
+    4 0 swap LOAD32 0 jit-literal rc-absolute-ppc-2/2 rt-vm jit-rel
     5 3 quot-xt-offset LWZ
     5 MTCTR
     BCTR
@@ -387,6 +387,7 @@ CONSTANT: rs-reg 14
 
 ! Comparisons
 : jit-compare ( insn -- )
+    t jit-literal
     0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel
     4 ds-reg 0 LWZ
     5 ds-reg -4 LWZU

From a50675473984aff1936183397eff751368ed104d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 15 Oct 2009 04:54:16 -0500
Subject: [PATCH 3/8] cpu.ppc: updates for write barrier and allocation changes
 (untested)

---
 basis/cpu/ppc/ppc.factor | 47 ++++++++++++++++++++++------------------
 1 file changed, 26 insertions(+), 21 deletions(-)

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 9237d320f3..5090320656 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -32,11 +32,11 @@ enable-float-intrinsics
 >>
 
 : %load-vm-addr ( reg -- )
-    0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm rel-fixup ;
+    0 swap LOAD32 0 rc-absolute-ppc-2/2 rel-vm ;
 
 : %load-vm-field-addr ( reg symbol -- )
-    [ drop %load-vm-addr ]
-    [ [ dup ] dip vm-field-offset ADDI ] 2bi ;
+    [ 0 swap LOAD32 ] dip
+    vm-field-offset rc-absolute-ppc-2/2 rel-vm ;
 
 M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
 
@@ -137,13 +137,10 @@ M:: ppc %dispatch ( src temp -- )
     temp MTCTR
     BCTR ;
 
-: (%slot-imm) ( obj slot tag -- reg offset )
-    [ cells ] dip - ; inline
-
 M: ppc %slot ( dst obj slot -- ) swapd LWZX ;
-M: ppc %slot-imm ( dst obj slot tag -- ) (%slot-imm) LWZ ;
+M: ppc %slot-imm ( dst obj slot tag -- ) slot-offset LWZ ;
 M: ppc %set-slot ( src obj slot -- ) swapd STWX ;
-M: ppc %set-slot-imm ( src obj slot tag -- ) (%slot-imm) STW ;
+M: ppc %set-slot-imm ( src obj slot tag -- ) slot-offset STW ;
 
 M:: ppc %string-nth ( dst src index temp -- )
     [
@@ -374,11 +371,11 @@ M: ppc %set-alien-double -rot STFD ;
     "nursery" %load-vm-field-addr ;
 
 : load-allot-ptr ( nursery-ptr allot-ptr -- )
-    [ drop load-zone-ptr ] [ swap 4 LWZ ] 2bi ;
+    [ drop load-zone-ptr ] [ swap 0 LWZ ] 2bi ;
 
 :: inc-allot-ptr ( nursery-ptr allot-ptr n -- )
     scratch-reg allot-ptr n 8 align ADDI
-    scratch-reg nursery-ptr 4 STW ;
+    scratch-reg nursery-ptr 0 STW ;
 
 :: store-header ( dst class -- )
     class type-number tag-fixnum scratch-reg LI
@@ -394,28 +391,36 @@ M:: ppc %allot ( dst size class nursery-ptr -- )
     dst class store-tagged ;
 
 : load-cards-offset ( dst -- )
-    [ "cards_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ;
+    0 swap LOAD32 rc-absolute-ppc-2/2 rel-cards-offset ;
 
 : load-decks-offset ( dst -- )
-    [ "decks_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi  ;
+    0 swap LOAD32 rc-absolute-ppc-2/2 rel-decks-offset
 
-M:: ppc %write-barrier ( src card# table -- )
+:: (%write-barrier) ( temp1 temp2 -- )
     card-mark scratch-reg LI
 
     ! Mark the card
-    table load-cards-offset
-    src card# card-bits SRWI
-    table scratch-reg card# STBX
+    temp1 temp1 card-bits SRWI
+    temp2 load-cards-offset
+    temp1 scratch-reg temp2 STBX
 
     ! Mark the card deck
-    table load-decks-offset
-    src card# deck-bits SRWI
-    table scratch-reg card# STBX ;
+    temp1 temp1 deck-bits SRWI
+    temp2 load-decks-offset
+    temp1 scratch-reg temp2 STBX ;
+
+M:: ppc %write-barrier ( src slot temp1 temp2 -- )
+    temp1 src slot ADD
+    temp1 temp2 (%write-barrier) ;
+
+M:: ppc %write-barrier-imm ( src slot temp1 temp2 -- )
+    temp1 src slot ADDI
+    temp1 temp2 (%write-barrier) ;
 
 M:: ppc %check-nursery ( label size temp1 temp2 -- )
     temp2 load-zone-ptr
-    temp1 temp2 cell LWZ
-    temp2 temp2 3 cells LWZ
+    temp1 temp2 0 LWZ
+    temp2 temp2 2 cells LWZ
     temp1 temp1 size ADDI
     ! is here >= end?
     temp1 0 temp2 CMP

From 13ca35ba79c35681d33ddfa821ac870dc2cd5a94 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 15 Oct 2009 05:01:20 -0500
Subject: [PATCH 4/8] cpu.ppc: fix typo

---
 basis/cpu/ppc/ppc.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 5090320656..e412d4f78d 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -394,7 +394,7 @@ M:: ppc %allot ( dst size class nursery-ptr -- )
     0 swap LOAD32 rc-absolute-ppc-2/2 rel-cards-offset ;
 
 : load-decks-offset ( dst -- )
-    0 swap LOAD32 rc-absolute-ppc-2/2 rel-decks-offset
+    0 swap LOAD32 rc-absolute-ppc-2/2 rel-decks-offset ;
 
 :: (%write-barrier) ( temp1 temp2 -- )
     card-mark scratch-reg LI

From 70c69fbd67d7668c229a4cfe58f10f783bdbe2e7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Thu, 15 Oct 2009 05:13:47 -0500
Subject: [PATCH 5/8] cpu.ppc: fix %write-barrier

---
 basis/cpu/ppc/ppc.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index e412d4f78d..bf239a696d 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -405,7 +405,7 @@ M:: ppc %allot ( dst size class nursery-ptr -- )
     temp1 scratch-reg temp2 STBX
 
     ! Mark the card deck
-    temp1 temp1 deck-bits SRWI
+    temp1 temp1 deck-bits card-bits - SRWI
     temp2 load-decks-offset
     temp1 scratch-reg temp2 STBX ;
 

From d3ec94b5c9ea5c8a5fd3e2a5989efd5df6d0b6f0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 15 Oct 2009 05:43:28 -0500
Subject: [PATCH 6/8] cpu.x86: just a cleanup

---
 basis/cpu/x86/x86.factor | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index af2d75f02d..abe6d308b8 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -387,6 +387,12 @@ M: x86 %vm-field-ptr ( dst field -- )
 : store-tagged ( dst tag -- )
     tag-number OR ;
 
+: load-cards-offset ( dst -- )
+    0 MOV rc-absolute-cell rel-cards-offset ;
+
+: load-decks-offset ( dst -- )
+    0 MOV rc-absolute-cell rel-decks-offset ;
+
 M:: x86 %allot ( dst size class nursery-ptr -- )
     nursery-ptr dst load-allot-ptr
     dst class store-header
@@ -399,12 +405,12 @@ M:: x86 %allot ( dst size class nursery-ptr -- )
 
     ! Mark the card
     temp1 card-bits SHR
-    temp2 0 MOV rc-absolute-cell rel-cards-offset
+    temp2 load-cards-offset
     temp2 temp1 [+] card-mark <byte> MOV
 
     ! Mark the card deck
     temp1 deck-bits card-bits - SHR
-    temp2 0 MOV rc-absolute-cell rel-decks-offset
+    temp2 load-decks-offset
     temp2 temp1 [+] card-mark <byte> MOV ;
 
 M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ;

From 45eb68fa383ffe1394b8fabebf580dd06ffffcd9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 15 Oct 2009 05:51:11 -0500
Subject: [PATCH 7/8] vm: during tenuring stage of aging collection, if tenured
 space fills up, it would attempt a to_tenured collection. this will succeed
 if all roots were tenured. however, this is unsound, because there's now an
 untraced segment of tenured space. fix: if tenuring fails, go on to do a full
 collection instead

---
 vm/aging_collector.cpp      |  16 +++-
 vm/code_heap.cpp            |   2 +-
 vm/collector.hpp            |   5 +-
 vm/copying_collector.hpp    |   9 +--
 vm/data_heap.hpp            |   5 --
 vm/debug.cpp                |  10 +--
 vm/full_collector.cpp       |   6 +-
 vm/gc.cpp                   | 141 ++++++++++++++++++------------------
 vm/gc.hpp                   |  51 ++++---------
 vm/nursery_collector.cpp    |   7 +-
 vm/to_tenured_collector.cpp |   7 +-
 vm/vm.hpp                   |  11 ++-
 12 files changed, 130 insertions(+), 140 deletions(-)

diff --git a/vm/aging_collector.cpp b/vm/aging_collector.cpp
index 6d67753b51..9a856374f6 100644
--- a/vm/aging_collector.cpp
+++ b/vm/aging_collector.cpp
@@ -4,12 +4,21 @@ namespace factor
 {
 
 aging_collector::aging_collector(factor_vm *myvm_) :
-	copying_collector<aging_space,aging_policy>
-	(myvm_,myvm_->data->aging,aging_policy(myvm_)) {}
+	copying_collector<aging_space,aging_policy>(
+		myvm_,
+		&myvm_->gc_stats.aging_stats,
+		myvm_->data->aging,
+		aging_policy(myvm_)) {}
 
 void factor_vm::collect_aging()
 {
 	{
+		/* Change the op so that if we fail here, we proceed to a full
+		tenured collection. We are collecting to tenured space, and
+		cards were unmarked, so we can't proceed with a to_tenured
+		collection. */
+		current_gc->op = collect_to_tenured_op;
+
 		to_tenured_collector collector(this);
 		collector.trace_cards(data->tenured,
 			card_points_to_aging,
@@ -17,6 +26,9 @@ void factor_vm::collect_aging()
 		collector.cheneys_algorithm();
 	}
 	{
+		/* If collection fails here, do a to_tenured collection. */
+		current_gc->op = collect_aging_op;
+
 		std::swap(data->aging,data->aging_semispace);
 		reset_generation(data->aging);
 
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 0cb2cae50f..6eb420cbde 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -229,7 +229,7 @@ critical here */
 void factor_vm::compact_code_heap()
 {
 	/* Free all unreachable code blocks, don't trace contexts */
-	garbage_collection(tenured_gen,false,false,0);
+	garbage_collection(collect_full_op,false,0);
 
 	/* Figure out where the code heap blocks are going to end up */
 	cell size = code->compute_heap_forwarding();
diff --git a/vm/collector.hpp b/vm/collector.hpp
index 8f9d4f26ac..24bba5d0a4 100644
--- a/vm/collector.hpp
+++ b/vm/collector.hpp
@@ -6,14 +6,16 @@ template<typename TargetGeneration, typename Policy> struct collector {
 	data_heap *data;
 	code_heap *code;
 	gc_state *current_gc;
+	generation_statistics *stats;
 	TargetGeneration *target;
 	Policy policy;
 
-	explicit collector(factor_vm *myvm_, TargetGeneration *target_, Policy policy_) :
+	explicit collector(factor_vm *myvm_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) :
 		myvm(myvm_),
 		data(myvm_->data),
 		code(myvm_->code),
 		current_gc(myvm_->current_gc),
+		stats(stats_),
 		target(target_),
 		policy(policy_) {}
 
@@ -74,7 +76,6 @@ template<typename TargetGeneration, typename Policy> struct collector {
 		memcpy(newpointer,untagged,size);
 		untagged->h.forward_to(newpointer);
 
-		generation_statistics *stats = &myvm->gc_stats.generations[current_gc->collecting_gen];
 		stats->object_count++;
 		stats->bytes_copied += size;
 
diff --git a/vm/copying_collector.hpp b/vm/copying_collector.hpp
index 1e338899b8..654b84f3ae 100644
--- a/vm/copying_collector.hpp
+++ b/vm/copying_collector.hpp
@@ -15,8 +15,8 @@ template<typename TargetGeneration, typename Policy>
 struct copying_collector : collector<TargetGeneration,Policy> {
 	cell scan;
 
-	explicit copying_collector(factor_vm *myvm_, TargetGeneration *target_, Policy policy_) :
-		collector<TargetGeneration,Policy>(myvm_,target_,policy_), scan(target_->here) {}
+	explicit copying_collector(factor_vm *myvm_, generation_statistics *stats_, TargetGeneration *target_, Policy policy_) :
+		collector<TargetGeneration,Policy>(myvm_,stats_,target_,policy_), scan(target_->here) {}
 
 	inline cell first_card_in_deck(cell deck)
 	{
@@ -28,11 +28,6 @@ struct copying_collector : collector<TargetGeneration,Policy> {
 		return first_card_in_deck(deck + 1);
 	}
 
-	inline cell card_to_addr(cell c)
-	{
-		return c << card_bits + this->data->start;
-	}
-
 	inline cell card_deck_for_address(cell a)
 	{
 		return addr_to_deck(a - this->data->start);
diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp
index 2370325cad..10f3698e74 100755
--- a/vm/data_heap.hpp
+++ b/vm/data_heap.hpp
@@ -27,9 +27,4 @@ struct data_heap {
 	data_heap *grow(cell requested_size);
 };
 
-static const cell nursery_gen = 0;
-static const cell aging_gen = 1;
-static const cell tenured_gen = 2;
-static const cell gen_count = 3;
-
 }
diff --git a/vm/debug.cpp b/vm/debug.cpp
index 64514b9261..3a8e847f14 100755
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@@ -211,9 +211,9 @@ void factor_vm::dump_memory(cell from, cell to)
 		dump_cell(from);
 }
 
-void factor_vm::dump_zone(cell gen, zone *z)
+void factor_vm::dump_zone(char *name, zone *z)
 {
-	print_string("Generation "); print_cell(gen); print_string(": ");
+	print_string(name); print_string(": ");
 	print_string("Start="); print_cell(z->start);
 	print_string(", size="); print_cell(z->size);
 	print_string(", here="); print_cell(z->here - z->start); nl();
@@ -221,9 +221,9 @@ void factor_vm::dump_zone(cell gen, zone *z)
 
 void factor_vm::dump_generations()
 {
-	dump_zone(nursery_gen,&nursery);
-	dump_zone(aging_gen,data->aging);
-	dump_zone(tenured_gen,data->tenured);
+	dump_zone("Nursery",&nursery);
+	dump_zone("Aging",data->aging);
+	dump_zone("Tenured",data->tenured);
 
 	print_string("Cards: base=");
 	print_cell((cell)data->cards);
diff --git a/vm/full_collector.cpp b/vm/full_collector.cpp
index 2496b963e4..db3d1dcc53 100644
--- a/vm/full_collector.cpp
+++ b/vm/full_collector.cpp
@@ -4,7 +4,11 @@ namespace factor
 {
 
 full_collector::full_collector(factor_vm *myvm_) :
-	copying_collector<tenured_space,full_policy>(myvm_,myvm_->data->tenured,full_policy(myvm_)) {}
+	copying_collector<tenured_space,full_policy>(
+		myvm_,
+		&myvm_->gc_stats.full_stats,
+		myvm_->data->tenured,
+		full_policy(myvm_)) {}
 
 struct stack_frame_marker {
 	factor_vm *myvm;
diff --git a/vm/gc.cpp b/vm/gc.cpp
index 10aee9a736..c4e8d25e20 100755
--- a/vm/gc.cpp
+++ b/vm/gc.cpp
@@ -3,14 +3,9 @@
 namespace factor
 {
 
-gc_state::gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_) :
-	data(data_),
-	growing_data_heap(growing_data_heap_),
-	collecting_gen(collecting_gen_),
-        collecting_aging_again(false),
-	start_time(current_micros()) { }
+gc_state::gc_state(gc_op op_) : op(op_), start_time(current_micros()) {}
 
-gc_state::~gc_state() { }
+gc_state::~gc_state() {}
 
 void factor_vm::update_dirty_code_blocks(std::set<code_block *> *remembered_set)
 {
@@ -21,80 +16,81 @@ void factor_vm::update_dirty_code_blocks(std::set<code_block *> *remembered_set)
 	for(; iter != end; iter++) update_literal_references(*iter);
 }
 
-void factor_vm::record_gc_stats()
+void factor_vm::record_gc_stats(generation_statistics *stats)
 {
-	generation_statistics *s = &gc_stats.generations[current_gc->collecting_gen];
-
 	cell gc_elapsed = (current_micros() - current_gc->start_time);
-	s->collections++;
-	s->gc_time += gc_elapsed;
-	if(s->max_gc_time < gc_elapsed)
-		s->max_gc_time = gc_elapsed;
+	stats->collections++;
+	stats->gc_time += gc_elapsed;
+	if(stats->max_gc_time < gc_elapsed)
+		stats->max_gc_time = gc_elapsed;
 }
 
 /* Collect gen and all younger generations.
 If growing_data_heap_ is true, we must grow the data heap to such a size that
 an allocation of requested_bytes won't fail */
-void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_, bool trace_contexts_p, cell requested_bytes)
+void factor_vm::garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes)
 {
 	assert(!gc_off);
 	assert(!current_gc);
 
 	save_stacks();
 
-	current_gc = new gc_state(data,growing_data_heap_,collecting_gen_);
+	current_gc = new gc_state(op);
 
 	/* Keep trying to GC higher and higher generations until we don't run out
 	of space */
 	if(setjmp(current_gc->gc_unwind))
 	{
 		/* We come back here if a generation is full */
-
-		/* We have no older generations we can try collecting, so we
-		resort to growing the data heap */
-		if(current_gc->collecting_tenured_p())
+		switch(current_gc->op)
 		{
-			assert(!current_gc->growing_data_heap);
-			current_gc->growing_data_heap = true;
-
+		case collect_nursery_op:
+			current_gc->op = collect_aging_op;
+			break;
+		case collect_aging_op:
+			current_gc->op = collect_to_tenured_op;
+			break;
+		case collect_to_tenured_op:
+			current_gc->op = collect_full_op;
+			break;
+		case collect_full_op:
 			/* Since we start tracing again, any previously
 			marked code blocks must be re-marked and re-traced */
 			code->clear_mark_bits();
-		}
-		/* we try collecting aging space twice before going on to
-		collect tenured */
-		else if(current_gc->collecting_aging_p()
-			&& !current_gc->collecting_aging_again)
-		{
-			current_gc->collecting_aging_again = true;
-		}
-		/* Collect the next oldest generation */
-		else
-		{
-			current_gc->collecting_gen++;
+			current_gc->op = collect_growing_heap_op;
+			break;
+		default:
+			critical_error("Bad GC op\n",op);
+			break;
 		}
 	}
 
-	if(current_gc->collecting_nursery_p())
+	switch(current_gc->op)
+	{
+	case collect_nursery_op:
 		collect_nursery();
-	else if(current_gc->collecting_aging_p())
-	{
-		if(current_gc->collecting_aging_again)
-			collect_to_tenured();
-		else
-			collect_aging();
+		record_gc_stats(&gc_stats.nursery_stats);
+		break;
+	case collect_aging_op:
+		collect_aging();
+		record_gc_stats(&gc_stats.aging_stats);
+		break;
+	case collect_to_tenured_op:
+		collect_to_tenured();
+		record_gc_stats(&gc_stats.aging_stats);
+		break;
+	case collect_full_op:
+		collect_full(trace_contexts_p);
+		record_gc_stats(&gc_stats.full_stats);
+		break;
+	case collect_growing_heap_op:
+		collect_growing_heap(requested_bytes,trace_contexts_p);
+		record_gc_stats(&gc_stats.full_stats);
+		break;
+	default:
+		critical_error("Bad GC op\n",op);
+		break;
 	}
-        else if(current_gc->collecting_tenured_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();
 
 	delete current_gc;
 	current_gc = NULL;
@@ -102,7 +98,7 @@ void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_
 
 void factor_vm::gc()
 {
-	garbage_collection(tenured_gen,false,true,0);
+	garbage_collection(collect_full_op,true,0);
 }
 
 void factor_vm::primitive_gc()
@@ -110,25 +106,28 @@ void factor_vm::primitive_gc()
 	gc();
 }
 
+void factor_vm::add_gc_stats(generation_statistics *stats, growable_array *result)
+{
+	result->add(allot_cell(stats->collections));
+	result->add(tag<bignum>(long_long_to_bignum(stats->gc_time)));
+	result->add(tag<bignum>(long_long_to_bignum(stats->max_gc_time)));
+	result->add(allot_cell(stats->collections == 0 ? 0 : stats->gc_time / stats->collections));
+	result->add(allot_cell(stats->object_count));
+	result->add(tag<bignum>(long_long_to_bignum(stats->bytes_copied)));
+}
+
 void factor_vm::primitive_gc_stats()
 {
 	growable_array result(this);
 
-	cell i;
-	u64 total_gc_time = 0;
+	add_gc_stats(&gc_stats.nursery_stats,&result);
+	add_gc_stats(&gc_stats.aging_stats,&result);
+	add_gc_stats(&gc_stats.full_stats,&result);
 
-	for(i = 0; i < gen_count; i++)
-	{
-		generation_statistics *s = &gc_stats.generations[i];
-		result.add(allot_cell(s->collections));
-		result.add(tag<bignum>(long_long_to_bignum(s->gc_time)));
-		result.add(tag<bignum>(long_long_to_bignum(s->max_gc_time)));
-		result.add(allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
-		result.add(allot_cell(s->object_count));
-		result.add(tag<bignum>(long_long_to_bignum(s->bytes_copied)));
-
-		total_gc_time += s->gc_time;
-	}
+	u64 total_gc_time =
+		gc_stats.nursery_stats.gc_time +
+		gc_stats.aging_stats.gc_time +
+		gc_stats.full_stats.gc_time;
 
 	result.add(tag<bignum>(ulong_long_to_bignum(total_gc_time)));
 	result.add(tag<bignum>(ulong_long_to_bignum(gc_stats.cards_scanned)));
@@ -186,7 +185,7 @@ void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
 	for(cell i = 0; i < gc_roots_size; i++)
 		gc_locals.push_back((cell)&gc_roots_base[i]);
 
-	garbage_collection(nursery_gen,false,true,0);
+	garbage_collection(collect_nursery_op,true,0);
 
 	for(cell i = 0; i < gc_roots_size; i++)
 		gc_locals.pop_back();
@@ -215,7 +214,7 @@ object *factor_vm::allot_object(header header, cell size)
 	{
 		/* If there is insufficient room, collect the nursery */
 		if(nursery.here + size > nursery.end)
-			garbage_collection(nursery_gen,false,true,0);
+			garbage_collection(collect_nursery_op,true,0);
 
 		obj = nursery.allot(size);
 	}
@@ -229,7 +228,7 @@ object *factor_vm::allot_object(header header, cell size)
 
 		/* If it still won't fit, grow the heap */
 		if(data->tenured->here + size > data->tenured->end)
-			garbage_collection(tenured_gen,true,true,size);
+			garbage_collection(collect_growing_heap_op,true,size);
 
 		obj = data->tenured->allot(size);
 
diff --git a/vm/gc.hpp b/vm/gc.hpp
index 02f54414fd..9469603d0c 100755
--- a/vm/gc.hpp
+++ b/vm/gc.hpp
@@ -1,6 +1,14 @@
 namespace factor
 {
 
+enum gc_op {
+	collect_nursery_op,
+	collect_aging_op,
+	collect_to_tenured_op,
+	collect_full_op,
+	collect_growing_heap_op
+};
+
 /* statistics */
 struct generation_statistics {
 	cell collections;
@@ -11,7 +19,9 @@ struct generation_statistics {
 };
 
 struct gc_statistics {
-	generation_statistics generations[gen_count];
+	generation_statistics nursery_stats;
+	generation_statistics aging_stats;
+	generation_statistics full_stats;
 	u64 cards_scanned;
 	u64 decks_scanned;
 	u64 card_scan_time;
@@ -19,47 +29,12 @@ struct gc_statistics {
 };
 
 struct gc_state {
-	/* The data heap we're collecting */
-	data_heap *data;
-
-	/* sometimes we grow the heap */
-	bool growing_data_heap;
-
-	/* Which generation is being collected */
-	cell collecting_gen;
-
-	/* If true, we are collecting aging space for the second time, so if it is still
-	   full, we go on to collect tenured */
-	bool collecting_aging_again;
-
-	/* GC start time, for benchmarking */
+	gc_op op;
 	u64 start_time;
-
         jmp_buf gc_unwind;
 
-	explicit gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_);
+	explicit gc_state(gc_op op_);
 	~gc_state();
-
-	inline bool collecting_nursery_p()
-	{
-		return collecting_gen == nursery_gen;
-	}
-
-	inline bool collecting_aging_p()
-	{
-		return collecting_gen == aging_gen;
-	}
-
-	inline bool collecting_tenured_p()
-	{
-		return collecting_gen == tenured_gen;
-	}
-
-	inline bool collecting_accumulation_gen_p()
-	{
-		return ((collecting_aging_p() && !collecting_aging_again)
-			|| collecting_tenured_p());
-	}
 };
 
 VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
diff --git a/vm/nursery_collector.cpp b/vm/nursery_collector.cpp
index de5eab4593..85f04dbb2d 100644
--- a/vm/nursery_collector.cpp
+++ b/vm/nursery_collector.cpp
@@ -4,8 +4,11 @@ namespace factor
 {
 
 nursery_collector::nursery_collector(factor_vm *myvm_) :
-	copying_collector<aging_space,nursery_policy>
-	(myvm_,myvm_->data->aging,nursery_policy(myvm_)) {}
+	copying_collector<aging_space,nursery_policy>(
+		myvm_,
+		&myvm_->gc_stats.nursery_stats,
+		myvm_->data->aging,
+		nursery_policy(myvm_)) {}
 
 void factor_vm::collect_nursery()
 {
diff --git a/vm/to_tenured_collector.cpp b/vm/to_tenured_collector.cpp
index 881b45fbc4..6689411684 100644
--- a/vm/to_tenured_collector.cpp
+++ b/vm/to_tenured_collector.cpp
@@ -4,8 +4,11 @@ namespace factor
 {
 
 to_tenured_collector::to_tenured_collector(factor_vm *myvm_) :
-	copying_collector<tenured_space,to_tenured_policy>
-	(myvm_,myvm_->data->tenured,to_tenured_policy(myvm_)) {}
+	copying_collector<tenured_space,to_tenured_policy>(
+		myvm_,
+		&myvm_->gc_stats.aging_stats,
+		myvm_->data->tenured,
+		to_tenured_policy(myvm_)) {}
 
 void factor_vm::collect_to_tenured()
 {
diff --git a/vm/vm.hpp b/vm/vm.hpp
index b6a3e30af3..73a423ccf4 100755
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -1,6 +1,8 @@
 namespace factor
 {
 
+struct growable_array;
+
 struct factor_vm
 {
 	// First five fields accessed directly by assembler. See vm.factor
@@ -240,8 +242,8 @@ struct factor_vm
 	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 record_gc_stats(generation_statistics *stats);
+	void garbage_collection(gc_op op, bool trace_contexts_p, cell requested_bytes);
 	void gc();
 	void primitive_gc();
 	void primitive_gc_stats();
@@ -249,6 +251,7 @@ struct factor_vm
 	void primitive_become();
 	void inline_gc(cell *gc_roots_base, cell gc_roots_size);
 	object *allot_object(header header, cell size);
+	void add_gc_stats(generation_statistics *stats, growable_array *result);
 	void primitive_clear_gc_stats();
 
 	template<typename Type> Type *allot(cell size)
@@ -259,7 +262,7 @@ struct factor_vm
 	inline void check_data_pointer(object *pointer)
 	{
 	#ifdef FACTOR_DEBUG
-		if(!(current_gc && current_gc->growing_data_heap))
+		if(!(current_gc && current_gc->op == collect_growing_heap_op))
 		{
 			assert((cell)pointer >= data->seg->start
 			       && (cell)pointer < data->seg->end);
@@ -298,7 +301,7 @@ struct factor_vm
 	void print_callstack();
 	void dump_cell(cell x);
 	void dump_memory(cell from, cell to);
-	void dump_zone(cell gen, zone *z);
+	void dump_zone(char *name, zone *z);
 	void dump_generations();
 	void dump_objects(cell type);
 	void find_data_references_step(cell *scan);

From d48c72a274b98a3e9080c4f233e7c274b883f219 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 15 Oct 2009 06:01:46 -0500
Subject: [PATCH 8/8] compiler.cfg: fix unit tests

---
 .../cfg/linear-scan/linear-scan-tests.factor  |   7 +-
 .../write-barrier/write-barrier-tests.factor  | 190 ------------------
 2 files changed, 4 insertions(+), 193 deletions(-)
 delete mode 100644 basis/compiler/cfg/write-barrier/write-barrier-tests.factor

diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index 3a9a7ac0a1..c144b5f07f 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -1306,10 +1306,11 @@ V{
         { slot 2 }
         { tag 7 }
     }
-    T{ ##write-barrier
+    T{ ##write-barrier-imm
         { src 141 }
-        { card# 145 }
-        { table 146 }
+        { slot 2 }
+        { temp1 145 }
+        { temp2 146 }
     }
     T{ ##inc-d { n -1 } }
     T{ ##inc-r { n -1 } }
diff --git a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor b/basis/compiler/cfg/write-barrier/write-barrier-tests.factor
deleted file mode 100644
index a73451042d..0000000000
--- a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor
+++ /dev/null
@@ -1,190 +0,0 @@
-! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs compiler.cfg
-compiler.cfg.alias-analysis compiler.cfg.block-joining
-compiler.cfg.branch-splitting compiler.cfg.copy-prop
-compiler.cfg.dce compiler.cfg.debugger
-compiler.cfg.instructions compiler.cfg.loop-detection
-compiler.cfg.registers compiler.cfg.ssa.construction
-compiler.cfg.tco compiler.cfg.useless-conditionals
-compiler.cfg.utilities compiler.cfg.value-numbering
-compiler.cfg.write-barrier cpu.architecture kernel
-kernel.private math namespaces sequences sequences.private
-tools.test vectors ;
-IN: compiler.cfg.write-barrier.tests
-
-: test-write-barrier ( insns -- insns )
-    <simple-block> dup write-barriers-step instructions>> ;
-
-[
-    V{
-        T{ ##peek f 4 D 0 f }
-        T{ ##allot f 7 24 array 8 f }
-        T{ ##load-immediate f 9 8 f }
-        T{ ##set-slot-imm f 9 7 1 3 f }
-        T{ ##set-slot-imm f 4 7 2 3 f }
-        T{ ##replace f 7 D 0 f }
-        T{ ##branch }
-    }
-] [
-    {
-        T{ ##peek f 4 D 0 }
-        T{ ##allot f 7 24 array 8 }
-        T{ ##load-immediate f 9 8 }
-        T{ ##set-slot-imm f 9 7 1 3 }
-        T{ ##write-barrier f 7 10 11 }
-        T{ ##set-slot-imm f 4 7 2 3 }
-        T{ ##write-barrier f 7 12 13 }
-        T{ ##replace f 7 D 0 }
-    } test-write-barrier
-] unit-test
-
-[
-    V{
-        T{ ##load-immediate f 4 24 }
-        T{ ##peek f 5 D -1 }
-        T{ ##peek f 6 D -2 }
-        T{ ##set-slot-imm f 5 6 3 2 }
-        T{ ##write-barrier f 6 7 8 }
-        T{ ##branch }
-    }
-] [
-    {
-        T{ ##load-immediate f 4 24 }
-        T{ ##peek f 5 D -1 }
-        T{ ##peek f 6 D -2 }
-        T{ ##set-slot-imm f 5 6 3 2 }
-        T{ ##write-barrier f 6 7 8 }
-    } test-write-barrier
-] unit-test
-
-[
-    V{
-        T{ ##peek f 19 D -3 }
-        T{ ##peek f 22 D -2 }
-        T{ ##set-slot-imm f 22 19 3 2 }
-        T{ ##write-barrier f 19 24 25 }
-        T{ ##peek f 28 D -1 }
-        T{ ##set-slot-imm f 28 19 4 2 }
-        T{ ##branch }
-    }
-] [
-    {
-        T{ ##peek f 19 D -3 }
-        T{ ##peek f 22 D -2 }
-        T{ ##set-slot-imm f 22 19 3 2 }
-        T{ ##write-barrier f 19 24 25 }
-        T{ ##peek f 28 D -1 }
-        T{ ##set-slot-imm f 28 19 4 2 }
-        T{ ##write-barrier f 19 30 3 }
-    } test-write-barrier
-] unit-test
-
-V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} 1 test-bb
-V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} 2 test-bb
-1 get 2 get 1vector >>successors drop
-cfg new 1 get >>entry 0 set
-
-[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
-[ V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} ] [ 1 get instructions>> ] unit-test
-[ V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-} ] [ 2 get instructions>> ] unit-test
-
-V{
-    T{ ##allot f 1 }
-} 1 test-bb
-V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} 2 test-bb
-1 get 2 get 1vector >>successors drop
-cfg new 1 get >>entry 0 set
-
-[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
-[ V{
-    T{ ##allot f 1 }
-} ] [ 1 get instructions>> ] unit-test
-[ V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-} ] [ 2 get instructions>> ] unit-test
-
-V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} 1 test-bb
-V{
-    T{ ##allot }
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} 2 test-bb
-1 get 2 get 1vector >>successors drop
-cfg new 1 get >>entry 0 set
-
-[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
-[ V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} ] [ 1 get instructions>> ] unit-test
-[ V{
-    T{ ##allot }
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} ] [ 2 get instructions>> ] unit-test
-
-V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} 1 test-bb
-V{
-    T{ ##allot }
-} 2 test-bb
-1 get 2 get 1vector >>successors drop
-V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} 3 test-bb
-2 get 3 get 1vector >>successors drop
-cfg new 1 get >>entry 0 set
-[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test
-[ V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} ] [ 1 get instructions>> ] unit-test
-[ V{ T{ ##allot } } ] [ 2 get instructions>> ] unit-test
-[ V{
-    T{ ##set-slot-imm f 2 1 3 4 }
-    T{ ##write-barrier f 1 2 3 }
-} ] [ 3 get instructions>> ] unit-test
-
-: reverse-here' ( seq -- )
-    { array } declare
-    [ length 2/ iota ] [ length ] [ ] tri
-    [ [ over - 1 - ] dip exchange-unsafe ] 2curry each ;
-
-: write-barrier-stats ( word -- cfg )
-    test-cfg first [
-        optimize-tail-calls
-        delete-useless-conditionals
-        split-branches
-        join-blocks
-        construct-ssa
-        alias-analysis
-        value-numbering
-        copy-propagation
-        eliminate-dead-code
-        eliminate-write-barriers
-    ] with-cfg
-    post-order>> write-barriers
-    [ [ loop-nesting-at ] [ length ] bi* ] assoc-map ;
-
-[ { { 0 1 } } ] [ \ reverse-here' write-barrier-stats ] unit-test