From 5fc3ad92f6872f01b8eb66366c33189fc848d25a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 2 Oct 2009 20:18:34 -0500
Subject: [PATCH 1/6] cpu.arm.assembler: dust it off, update to work with
 contemporary Factor, and clean it up a bit

---
 .../cpu}/arm/assembler/assembler-tests.factor |   7 +-
 .../cpu}/arm/assembler/assembler.factor       | 271 ++++++++++--------
 .../cpu}/arm/assembler/authors.txt            |   0
 3 files changed, 158 insertions(+), 120 deletions(-)
 rename {unmaintained => basis/cpu}/arm/assembler/assembler-tests.factor (89%)
 rename {unmaintained => basis/cpu}/arm/assembler/assembler.factor (53%)
 rename {unmaintained => basis/cpu}/arm/assembler/authors.txt (100%)

diff --git a/unmaintained/arm/assembler/assembler-tests.factor b/basis/cpu/arm/assembler/assembler-tests.factor
similarity index 89%
rename from unmaintained/arm/assembler/assembler-tests.factor
rename to basis/cpu/arm/assembler/assembler-tests.factor
index a30ab9f797..3164fc197a 100644
--- a/unmaintained/arm/assembler/assembler-tests.factor
+++ b/basis/cpu/arm/assembler/assembler-tests.factor
@@ -1,8 +1,9 @@
 IN: cpu.arm.assembler.tests
-USING: assembler-arm math test namespaces sequences kernel
-quotations ;
+USING: cpu.arm.assembler math tools.test namespaces make
+sequences kernel quotations ;
+FROM: cpu.arm.assembler => B ;
 
-: test-opcode [ { } make first ] curry unit-test ;
+: test-opcode ( expect quot -- ) [ { } make first ] curry unit-test ;
 
 [ HEX: ea000000 ] [ 0 B ] test-opcode
 [ HEX: eb000000 ] [ 0 BL ] test-opcode
diff --git a/unmaintained/arm/assembler/assembler.factor b/basis/cpu/arm/assembler/assembler.factor
similarity index 53%
rename from unmaintained/arm/assembler/assembler.factor
rename to basis/cpu/arm/assembler/assembler.factor
index 5a69f93d85..38e385020f 100755
--- a/unmaintained/arm/assembler/assembler.factor
+++ b/basis/cpu/arm/assembler/assembler.factor
@@ -1,31 +1,46 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generator generator.fixup kernel sequences words
-namespaces math math.bitfields ;
+USING: accessors arrays combinators kernel make math math.bitwise
+namespaces sequences words words.symbol parser ;
 IN: cpu.arm.assembler
 
-: define-registers ( seq -- )
-    dup length [ "register" set-word-prop ] 2each ;
+! Registers
+<<
 
-SYMBOL: R0
-SYMBOL: R1
-SYMBOL: R2
-SYMBOL: R3
-SYMBOL: R4
-SYMBOL: R5
-SYMBOL: R6
-SYMBOL: R7
-SYMBOL: R8
-SYMBOL: R9
-SYMBOL: R10
-SYMBOL: R11
-SYMBOL: R12
-SYMBOL: R13
-SYMBOL: R14
-SYMBOL: R15
+SYMBOL: registers
 
-{ R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 R11 R12 R13 R14 R15 }
-define-registers
+V{ } registers set-global
+
+SYNTAX: REGISTER:
+    CREATE-WORD
+    [ define-symbol ]
+    [ registers get length "register" set-word-prop ]
+    [ registers get push ]
+    tri ;
+
+>>
+
+REGISTER: R0
+REGISTER: R1
+REGISTER: R2
+REGISTER: R3
+REGISTER: R4
+REGISTER: R5
+REGISTER: R6
+REGISTER: R7
+REGISTER: R8
+REGISTER: R9
+REGISTER: R10
+REGISTER: R11
+REGISTER: R12
+REGISTER: R13
+REGISTER: R14
+REGISTER: R15
+
+ALIAS: SL R10 ALIAS: FP R11 ALIAS: IP R12
+ALIAS: SP R13 ALIAS: LR R14 ALIAS: PC R15
+
+<PRIVATE
 
 PREDICATE: register < word register >boolean ;
 
@@ -33,8 +48,7 @@ GENERIC: register ( register -- n )
 M: word register "register" word-prop ;
 M: f register drop 0 ;
 
-: SL R10 ; inline : FP R11 ; inline : IP R12 ; inline
-: SP R13 ; inline : LR R14 ; inline : PC R15 ; inline
+PRIVATE>
 
 ! Condition codes
 SYMBOL: cond-code
@@ -46,43 +60,52 @@ SYMBOL: cond-code
     #! Default value is BIN: 1110 AL (= always)
     cond-code [ f ] change BIN: 1110 or ;
 
-: EQ BIN: 0000 >CC ;
-: NE BIN: 0001 >CC ;
-: CS BIN: 0010 >CC ;
-: CC BIN: 0011 >CC ;
-: LO BIN: 0100 >CC ;
-: PL BIN: 0101 >CC ;
-: VS BIN: 0110 >CC ;
-: VC BIN: 0111 >CC ;
-: HI BIN: 1000 >CC ;
-: LS BIN: 1001 >CC ;
-: GE BIN: 1010 >CC ;
-: LT BIN: 1011 >CC ;
-: GT BIN: 1100 >CC ;
-: LE BIN: 1101 >CC ;
-: AL BIN: 1110 >CC ;
-: NV BIN: 1111 >CC ;
+: EQ ( -- ) BIN: 0000 >CC ;
+: NE ( -- ) BIN: 0001 >CC ;
+: CS ( -- ) BIN: 0010 >CC ;
+: CC ( -- ) BIN: 0011 >CC ;
+: LO ( -- ) BIN: 0100 >CC ;
+: PL ( -- ) BIN: 0101 >CC ;
+: VS ( -- ) BIN: 0110 >CC ;
+: VC ( -- ) BIN: 0111 >CC ;
+: HI ( -- ) BIN: 1000 >CC ;
+: LS ( -- ) BIN: 1001 >CC ;
+: GE ( -- ) BIN: 1010 >CC ;
+: LT ( -- ) BIN: 1011 >CC ;
+: GT ( -- ) BIN: 1100 >CC ;
+: LE ( -- ) BIN: 1101 >CC ;
+: AL ( -- ) BIN: 1110 >CC ;
+: NV ( -- ) BIN: 1111 >CC ;
+
+<PRIVATE
 
 : (insn) ( n -- ) CC> 28 shift bitor , ;
 
 : insn ( bitspec -- ) bitfield (insn) ; inline
 
 ! Branching instructions
-GENERIC# (B) 1 ( signed-imm-24 l -- )
+GENERIC# (B) 1 ( target l -- )
 
 M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ;
-M: word (B) 0 swap (B) rc-relative-arm-3 rel-word ;
-M: label (B) 0 swap (B) rc-relative-arm-3 label-fixup ;
 
-: B 0 (B) ; : BL 1 (B) ;
+PRIVATE>
+
+: B ( target -- ) 0 (B) ;
+: BL ( target -- ) 1 (B) ;
 
 ! Data processing instructions
+<PRIVATE
+
 SYMBOL: updates-cond-code
 
+PRIVATE>
+
 : S ( -- ) updates-cond-code on ;
 
 : S> ( -- ? ) updates-cond-code [ f ] change ;
 
+<PRIVATE
+
 : sinsn ( bitspec -- )
     bitfield S> [ 20 2^ bitor ] when (insn) ; inline
 
@@ -100,21 +123,25 @@ M: register shift-imm/reg ( Rs Rm shift -- n )
         { register 0 }
     } bitfield ;
 
-GENERIC: shifter-op ( shifter-op -- n )
+PRIVATE>
 
 TUPLE: IMM immed rotate ;
 C: <IMM> IMM
 
-M: IMM shifter-op
-    dup IMM-immed swap IMM-rotate
-    { { 1 25 } 8 0 } bitfield ;
-
 TUPLE: shifter Rm by shift ;
 C: <shifter> shifter
 
+<PRIVATE
+
+GENERIC: shifter-op ( shifter-op -- n )
+
+M: IMM shifter-op
+    [ immed>> ] [ rotate>> ] bi { { 1 25 } 8 0 } bitfield ;
+
 M: shifter shifter-op
-    dup shifter-by over shifter-Rm rot shifter-shift
-    shift-imm/reg ;
+    [ by>> ] [ Rm>> ] [ shift>> ] tri shift-imm/reg ;
+
+PRIVATE>
 
 : <LSL> ( Rm shift-imm/Rs -- shifter-op ) BIN: 00 <shifter> ;
 : <LSR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 01 <shifter> ;
@@ -123,9 +150,10 @@ M: shifter shifter-op
 : <RRX> ( Rm -- shifter-op ) 0 <ROR> ;
 
 M: register shifter-op 0 <LSL> shifter-op ;
-
 M: integer shifter-op 0 <IMM> shifter-op ;
 
+<PRIVATE
+
 : addr1 ( Rd Rn shifter-op opcode -- )
     {
         21 ! opcode
@@ -134,30 +162,38 @@ M: integer shifter-op 0 <IMM> shifter-op ;
         { register 12 } ! Rd
     } sinsn ;
 
-: AND BIN: 0000 addr1 ;
-: EOR BIN: 0001 addr1 ;
-: SUB BIN: 0010 addr1 ;
-: RSB BIN: 0011 addr1 ;
-: ADD BIN: 0100 addr1 ;
-: ADC BIN: 0101 addr1 ;
-: SBC BIN: 0110 addr1 ;
-: RSC BIN: 0111 addr1 ;
-: ORR BIN: 1100 addr1 ;
-: BIC BIN: 1110 addr1 ;
+PRIVATE>
 
-: MOV f swap BIN: 1101 addr1 ;
-: MVN f swap BIN: 1111 addr1 ;
+: AND ( Rd Rn shifter-op -- ) BIN: 0000 addr1 ;
+: EOR ( Rd Rn shifter-op -- ) BIN: 0001 addr1 ;
+: SUB ( Rd Rn shifter-op -- ) BIN: 0010 addr1 ;
+: RSB ( Rd Rn shifter-op -- ) BIN: 0011 addr1 ;
+: ADD ( Rd Rn shifter-op -- ) BIN: 0100 addr1 ;
+: ADC ( Rd Rn shifter-op -- ) BIN: 0101 addr1 ;
+: SBC ( Rd Rn shifter-op -- ) BIN: 0110 addr1 ;
+: RSC ( Rd Rn shifter-op -- ) BIN: 0111 addr1 ;
+: ORR ( Rd Rn shifter-op -- ) BIN: 1100 addr1 ;
+: BIC ( Rd Rn shifter-op -- ) BIN: 1110 addr1 ;
+
+: MOV ( Rd shifter-op -- ) [ f ] dip BIN: 1101 addr1 ;
+: MVN ( Rd shifter-op -- ) [ f ] dip BIN: 1111 addr1 ;
 
 ! These always update the condition code flags
-: (CMP) >r f -rot r> S addr1 ;
+<PRIVATE
 
-: TST BIN: 1000 (CMP) ;
-: TEQ BIN: 1001 (CMP) ;
-: CMP BIN: 1010 (CMP) ;
-: CMN BIN: 1011 (CMP) ;
+: (CMP) ( Rn shifter-op opcode -- ) [ f ] 3dip S addr1 ;
+
+PRIVATE>
+
+: TST ( Rn shifter-op -- ) BIN: 1000 (CMP) ;
+: TEQ ( Rn shifter-op -- ) BIN: 1001 (CMP) ;
+: CMP ( Rn shifter-op -- ) BIN: 1010 (CMP) ;
+: CMN ( Rn shifter-op -- ) BIN: 1011 (CMP) ;
 
 ! Multiply instructions
-: (MLA)  ( Rd Rm Rs Rn a -- )
+<PRIVATE
+
+: (MLA) ( Rd Rm Rs Rn a -- )
     {
         21
         { register 12 }
@@ -168,9 +204,6 @@ M: integer shifter-op 0 <IMM> shifter-op ;
         { 1 4 }
     } sinsn ;
 
-: MUL ( Rd Rm Rs -- ) f 0 (MLA) ;
-: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ;
-
 : (S/UMLAL)  ( RdLo RdHi Rm Rs s a -- )
     {
         { 1 23 }
@@ -184,8 +217,15 @@ M: integer shifter-op 0 <IMM> shifter-op ;
         { 1 4 }
     } sinsn ;
 
-: SMLAL 1 1 (S/UMLAL) ; : SMULL 1 0 (S/UMLAL) ;
-: UMLAL 0 1 (S/UMLAL) ; : UMULL 0 0 (S/UMLAL) ;
+PRIVATE>
+
+: MUL ( Rd Rm Rs -- ) f 0 (MLA) ;
+: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ;
+
+: SMLAL ( RdLo RdHi Rm Rs -- ) 1 1 (S/UMLAL) ;
+: SMULL ( RdLo RdHi Rm Rs -- ) 1 0 (S/UMLAL) ;
+: UMLAL ( RdLo RdHi Rm Rs -- ) 0 1 (S/UMLAL) ;
+: UMULL ( RdLo RdHi Rm Rs -- ) 0 0 (S/UMLAL) ;
 
 ! Miscellaneous arithmetic instructions
 : CLZ ( Rd Rm -- )
@@ -203,39 +243,21 @@ M: integer shifter-op 0 <IMM> shifter-op ;
 ! Status register acess instructions
 
 ! Load and store instructions
+<PRIVATE
+
 GENERIC: addressing-mode-2 ( addressing-mode -- n )
 
-TUPLE: addressing p u w ;
-: <addressing> ( delegate p u w -- addressing )
-    {
-        set-delegate
-        set-addressing-p
-        set-addressing-u
-        set-addressing-w
-    } addressing construct ;
+TUPLE: addressing base p u w ;
+C: <addressing> addressing
 
 M: addressing addressing-mode-2
-    {
-        addressing-p addressing-u addressing-w delegate
-    } get-slots addressing-mode-2
+    { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-2 ] } cleave
     { 0 21 23 24 } bitfield ;
 
 M: integer addressing-mode-2 ;
 
 M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ;
 
-! Offset
-: <+> 1 1 0 <addressing> ;
-: <-> 1 0 0 <addressing> ;
-
-! Pre-indexed
-: <!+> 1 1 1 <addressing> ;
-: <!-> 1 0 1 <addressing> ;
-
-! Post-indexed
-: <+!> 0 1 0 <addressing> ;
-: <-!> 0 0 0 <addressing> ;
-
 : addr2 ( Rd Rn addressing-mode b l -- )
     {
         { 1 26 }
@@ -246,16 +268,32 @@ M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ;
         { register 12 }
     } insn ;
 
-: LDR 0 1 addr2 ;
-: LDRB 1 1 addr2 ;
-: STR 0 0 addr2 ;
-: STRB 1 0 addr2 ;
+PRIVATE>
+
+! Offset
+: <+> ( base -- addressing ) 1 1 0 <addressing> ;
+: <-> ( base -- addressing ) 1 0 0 <addressing> ;
+
+! Pre-indexed
+: <!+> ( base -- addressing ) 1 1 1 <addressing> ;
+: <!-> ( base -- addressing ) 1 0 1 <addressing> ;
+
+! Post-indexed
+: <+!> ( base -- addressing ) 0 1 0 <addressing> ;
+: <-!> ( base -- addressing ) 0 0 0 <addressing> ;
+
+: LDR  ( Rd Rn addressing-mode -- ) 0 1 addr2 ;
+: LDRB ( Rd Rn addressing-mode -- ) 1 1 addr2 ;
+: STR  ( Rd Rn addressing-mode -- ) 0 0 addr2 ;
+: STRB ( Rd Rn addressing-mode -- ) 1 0 addr2 ;
 
 ! We might have to simulate these instructions since older ARM
 ! chips don't have them.
 SYMBOL: have-BX?
 SYMBOL: have-BLX?
 
+<PRIVATE
+
 GENERIC# (BX) 1 ( Rm l -- )
 
 M: register (BX) ( Rm l -- )
@@ -270,24 +308,21 @@ M: register (BX) ( Rm l -- )
         { register 0 }
     } insn ;
 
-M: word (BX) 0 swap (BX) rc-relative-arm-3 rel-word ;
+PRIVATE>
 
-M: label (BX) 0 swap (BX) rc-relative-arm-3 label-fixup ;
+: BX ( Rm -- ) have-BX? get [ 0 (BX) ] [ [ PC ] dip MOV ] if ;
 
-: BX have-BX? get [ 0 (BX) ] [ PC swap MOV ] if ;
-
-: BLX have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ;
+: BLX ( Rm -- ) have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ;
 
 ! More load and store instructions
+<PRIVATE
+
 GENERIC: addressing-mode-3 ( addressing-mode -- n )
 
-: b>n/n ( b -- n n ) dup -4 shift swap HEX: f bitand ;
+: b>n/n ( b -- n n ) [ -4 shift ] [ HEX: f bitand ] bi ;
 
 M: addressing addressing-mode-3
-    [ addressing-p ] keep
-    [ addressing-u ] keep
-    [ addressing-w ] keep
-    delegate addressing-mode-3
+    { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-3 ] } cleave
     { 0 21 23 24 } bitfield ;
 
 M: integer addressing-mode-3
@@ -318,10 +353,12 @@ M: object addressing-mode-3
         { register 12 }
     } insn ;
 
-: LDRH 1 1 0 addr3 ;
-: LDRSB 0 1 1 addr3 ;
-: LDRSH 1 1 1 addr3 ;
-: STRH 1 0 0 addr3 ;
+PRIVATE>
+
+: LDRH  ( Rn Rd addressing-mode -- ) 1 1 0 addr3 ;
+: LDRSB ( Rn Rd addressing-mode -- ) 0 1 1 addr3 ;
+: LDRSH ( Rn Rd addressing-mode -- ) 1 1 1 addr3 ;
+: STRH  ( Rn Rd addressing-mode -- ) 1 0 0 addr3 ;
 
 ! Load and store multiple instructions
 
diff --git a/unmaintained/arm/assembler/authors.txt b/basis/cpu/arm/assembler/authors.txt
similarity index 100%
rename from unmaintained/arm/assembler/authors.txt
rename to basis/cpu/arm/assembler/authors.txt

From cfc8b06ac0f50d90a93bc4da7ef2e6f5676daaea Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Fri, 2 Oct 2009 20:36:19 -0500
Subject: [PATCH 2/6] vm: cleanup in os-genunix.cpp

---
 vm/os-genunix.cpp | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/vm/os-genunix.cpp b/vm/os-genunix.cpp
index 015a76f842..7bbe388ff2 100644
--- a/vm/os-genunix.cpp
+++ b/vm/os-genunix.cpp
@@ -26,12 +26,7 @@ const char *default_image_path()
 	if(!path)
 		return "factor.image";
 
-	/* We can't call strlen() here because with gcc 4.1.2 this
-	causes an internal compiler error. */
-	int len = 0;
-	const char *iter = path;
-	while(*iter) { len++; iter++; }
-
+	int len = strlen(path);
 	char *new_path = new char[PATH_MAX + SUFFIX_LEN + 1];
 	memcpy(new_path,path,len + 1);
 	memcpy(new_path + len,SUFFIX,SUFFIX_LEN + 1);

From 21eea4d88cd5ae8ee1028f6f2598f7d4b85258d6 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Fri, 2 Oct 2009 21:00:12 -0500
Subject: [PATCH 3/6] Allow access to command line arguments in deployed apps

---
 basis/command-line/command-line-docs.factor |  6 +++---
 basis/tools/deploy/deploy-tests.factor      |  9 ++++++++-
 basis/tools/deploy/shaker/shaker.factor     | 11 +++++++----
 basis/tools/deploy/test/15/15.factor        |  8 ++++++++
 basis/tools/deploy/test/test.factor         |  7 +++++--
 5 files changed, 31 insertions(+), 10 deletions(-)
 create mode 100644 basis/tools/deploy/test/15/15.factor

diff --git a/basis/command-line/command-line-docs.factor b/basis/command-line/command-line-docs.factor
index 33119eb061..07930ad34b 100644
--- a/basis/command-line/command-line-docs.factor
+++ b/basis/command-line/command-line-docs.factor
@@ -25,7 +25,7 @@ HELP: (command-line)
 { $description "Outputs the command line parameters which were passed to the Factor VM on startup." } ;
 
 HELP: command-line
-{ $var-description "The command line parameters which follow the name of the script on the command line." } ;
+{ $var-description "When Factor is run with a script, this variable contains command line parameters which follow the name of the script on the command line. In deployed applications, it contains the entire command line. In all other cases it is set to " { $link f } "." } ;
 
 HELP: main-vocab-hook
 { $var-description "Global variable holding a quotation which outputs a vocabulary name. UI backends set this so that the UI can automatically start if the prerequisites are met (for example, " { $snippet "$DISPLAY" } " being set on X11)." } ;
@@ -139,8 +139,8 @@ $nl
 
 ARTICLE: "cli" "Command line arguments"
 "Factor command line usage:"
-{ $code "factor [system switches...] [script args...]" }
-"Zero or more system switches can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup, any arguments after the script file are stored in a variable, with no further processing by Factor itself:"
+{ $code "factor [VM args...] [script] [args...]" }
+"Zero or more VM arguments can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup, any arguments after the script file are stored in the following variable, with no further processing by Factor itself:"
 { $subsections command-line }
 "Instead of running a script, it is also possible to run a vocabulary; this invokes the vocabulary's " { $link POSTPONE: MAIN: } " word:"
 { $code "factor [system switches...] -run=<vocab name>" }
diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor
index 36045a6b22..e465578903 100644
--- a/basis/tools/deploy/deploy-tests.factor
+++ b/basis/tools/deploy/deploy-tests.factor
@@ -105,4 +105,11 @@ os windows? os macosx? or [
 
 os macosx? [
     [ ] [ "tools.deploy.test.14" shake-and-bake run-temp-image ] unit-test
-] when
\ No newline at end of file
+] when
+
+[ { "a" "b" "c" } ] [
+    "tools.deploy.test.15" shake-and-bake deploy-test-command
+    { "a" "b" "c" } append
+    ascii [ lines ] with-process-reader
+    rest
+] unit-test
\ No newline at end of file
diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 825b6f9c54..c623ea4194 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -7,9 +7,8 @@ words memory kernel.private continuations io vocabs.loader
 system strings sets vectors quotations byte-arrays sorting
 compiler.units definitions generic generic.standard
 generic.single tools.deploy.config combinators classes
-classes.builtin slots.private grouping ;
+classes.builtin slots.private grouping command-line ;
 QUALIFIED: bootstrap.stage2
-QUALIFIED: command-line
 QUALIFIED: compiler.errors
 QUALIFIED: continuations
 QUALIFIED: definitions
@@ -22,11 +21,14 @@ IN: tools.deploy.shaker
 
 ! This file is some hairy shit.
 
+: add-command-line-hook ( -- )
+    [ (command-line) command-line set-global ] "command-line"
+    init-hooks get set-at ;
+
 : strip-init-hooks ( -- )
     "Stripping startup hooks" show
     {
         "alien.strings"
-        "command-line"
         "cpu.x86"
         "destructors"
         "environment"
@@ -328,7 +330,7 @@ IN: tools.deploy.shaker
                 classes-intersect-cache
                 implementors-map
                 update-map
-                command-line:main-vocab-hook
+                main-vocab-hook
                 compiled-crossref
                 compiled-generic-crossref
                 compiler-impl
@@ -503,6 +505,7 @@ SYMBOL: deploy-vocab
     strip-debugger
     compute-next-methods
     strip-init-hooks
+    add-command-line-hook
     strip-c-io
     strip-default-methods
     strip-compiler-classes
diff --git a/basis/tools/deploy/test/15/15.factor b/basis/tools/deploy/test/15/15.factor
new file mode 100644
index 0000000000..a64c3ca81e
--- /dev/null
+++ b/basis/tools/deploy/test/15/15.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: command-line io namespaces sequences ;
+IN: tools.deploy.test.15
+
+: main ( -- ) command-line get [ print ] each ;
+
+MAIN: main
diff --git a/basis/tools/deploy/test/test.factor b/basis/tools/deploy/test/test.factor
index 6a6f9cf8fd..908540254a 100755
--- a/basis/tools/deploy/test/test.factor
+++ b/basis/tools/deploy/test/test.factor
@@ -19,7 +19,10 @@ IN: tools.deploy.test
     ] bi*
     <= ;
 
-: run-temp-image ( -- )
+: deploy-test-command ( -- args )
     os macosx?
     "resource:Factor.app/Contents/MacOS/factor" normalize-path vm ?
-    "-i=" "test.image" temp-file append 2array try-output-process ;
\ No newline at end of file
+    "-i=" "test.image" temp-file append 2array ;
+
+: run-temp-image ( -- )
+    deploy-test-command try-output-process ;
\ No newline at end of file

From bcd5c5c635b9671dd7acd6b25a6445b270a05690 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Sat, 3 Oct 2009 06:53:23 -0500
Subject: [PATCH 4/6] Fix deploy tests and update command-line docs a bit

---
 basis/command-line/command-line-docs.factor |  6 ++----
 basis/tools/deploy/deploy-tests.factor      | 10 +++++-----
 2 files changed, 7 insertions(+), 9 deletions(-)

diff --git a/basis/command-line/command-line-docs.factor b/basis/command-line/command-line-docs.factor
index 07930ad34b..6bcdd4f4af 100644
--- a/basis/command-line/command-line-docs.factor
+++ b/basis/command-line/command-line-docs.factor
@@ -129,12 +129,10 @@ $nl
     "\"factor-rc\" rc-path print"
     "\"factor-boot-rc\" rc-path print"
 }
-"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration, adds an additional vocabulary root (see " { $link "vocabs.roots" } "), and increases the font size in the UI by setting the DPI (dots-per-inch) variable:"
+"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration:"
 { $code
-    "USING: editors.gvim vocabs.loader ui.freetype namespaces sequences ;"
+    "USING: editors.gvim namespaces ;"
     "\"/opt/local/bin\" \\ gvim-path set-global"
-    "\"/home/jane/src/\" vocab-roots get push"
-    "100 dpi set-global"
 } ;
 
 ARTICLE: "cli" "Command line arguments"
diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor
index e465578903..012b540511 100644
--- a/basis/tools/deploy/deploy-tests.factor
+++ b/basis/tools/deploy/deploy-tests.factor
@@ -1,9 +1,9 @@
+USING: tools.test system io io.encodings.ascii io.pathnames
+io.files io.files.info io.files.temp kernel tools.deploy.config
+tools.deploy.config.editor tools.deploy.backend math sequences
+io.launcher arrays namespaces continuations layouts accessors
+urls math.parser io.directories tools.deploy.test ;
 IN: tools.deploy.tests
-USING: tools.test system io.pathnames io.files io.files.info
-io.files.temp kernel tools.deploy.config tools.deploy.config.editor
-tools.deploy.backend math sequences io.launcher arrays namespaces
-continuations layouts accessors io.encodings.ascii urls math.parser
-io.directories tools.deploy.test ;
 
 [ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test
 

From c4ef640f4d201ef4cb9257becb51272ccf52b014 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Sat, 3 Oct 2009 08:47:05 -0500
Subject: [PATCH 5/6] Big VM cleanup - Move forward declarations of 'struct
 factor_vm' to one place - Rename template parameters from T and TYPE to
 descriptive names. New convention: CamelCase for template parameters - Change
 some higher-order functions taking function pointers into templates, and
 define classes overriding operator(). There's a bit of new boilerplate here
 but its more consistent than the old mish-mash approaches - Put GC state into
 a gc_state struct - Use exceptions instead of longjmp for non-local control
 transfer in GC - In code GC, instead of interleaving code block tracing with
 copying, add code blocks which need to be revisited to an std::set stored in
 the gc_state

---
 vm/arrays.hpp         |   2 +-
 vm/bignum.hpp         |   1 -
 vm/byte_arrays.hpp    |   2 +-
 vm/callstack.cpp      |  11 +-
 vm/callstack.hpp      |  27 +--
 vm/code_block.cpp     | 148 ++++++++--------
 vm/code_heap.cpp      |  60 ++++---
 vm/code_heap.hpp      |  10 ++
 vm/contexts.hpp       |   1 -
 vm/cpu-arm.hpp        |   2 +-
 vm/cpu-x86.hpp        |   2 +-
 vm/data_gc.cpp        | 391 ++++++++++++++++++++++++------------------
 vm/data_gc.hpp        |  47 ++++-
 vm/data_heap.cpp      |   8 +-
 vm/data_heap.hpp      |   2 +-
 vm/debug.cpp          |  83 +++++----
 vm/factor.cpp         |   2 +-
 vm/generic_arrays.hpp |  28 +--
 vm/heap.cpp           |  66 ++-----
 vm/heap.hpp           |  44 ++++-
 vm/image.cpp          |  65 ++++---
 vm/inline_cache.cpp   |   2 +-
 vm/jit.hpp            |   2 +-
 vm/layouts.hpp        |   6 +-
 vm/local_roots.hpp    |  14 +-
 vm/master.hpp         |  21 ++-
 vm/os-linux-ppc.hpp   |   2 +-
 vm/os-macosx-ppc.hpp  |   2 +-
 vm/os-unix.hpp        |   3 +-
 vm/os-windows-nt.hpp  |   1 -
 vm/profiler.cpp       |   3 +-
 vm/quotations.cpp     |   4 +-
 vm/quotations.hpp     |   2 +-
 vm/run.cpp            |   2 +-
 vm/segments.hpp       |   4 +-
 vm/tagged.hpp         |  36 ++--
 vm/vm.hpp             | 136 +++++++--------
 37 files changed, 685 insertions(+), 557 deletions(-)

diff --git a/vm/arrays.hpp b/vm/arrays.hpp
index 3abd78474e..c3815c9f60 100755
--- a/vm/arrays.hpp
+++ b/vm/arrays.hpp
@@ -25,7 +25,7 @@ struct growable_array {
 	cell count;
 	gc_root<array> elements;
 
-	growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
+	explicit growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
 
 	void add(cell elt);
 	void trim();
diff --git a/vm/bignum.hpp b/vm/bignum.hpp
index 7d230c3897..c6aaf447a4 100644
--- a/vm/bignum.hpp
+++ b/vm/bignum.hpp
@@ -44,7 +44,6 @@ enum bignum_comparison
   bignum_comparison_greater = 1
 };
 
-struct factor_vm;
 bignum * digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int,factor_vm*), unsigned int radix, int negative_p);
 
 }
diff --git a/vm/byte_arrays.hpp b/vm/byte_arrays.hpp
index 0d74793daf..e5a1e6a842 100755
--- a/vm/byte_arrays.hpp
+++ b/vm/byte_arrays.hpp
@@ -5,7 +5,7 @@ struct growable_byte_array {
 	cell count;
 	gc_root<byte_array> elements;
 
-	growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
+	explicit growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
 
 	void append_bytes(void *elts, cell len);
 	void append_byte_array(cell elts);
diff --git a/vm/callstack.cpp b/vm/callstack.cpp
index eb967df559..eccc4f9bfb 100755
--- a/vm/callstack.cpp
+++ b/vm/callstack.cpp
@@ -116,7 +116,7 @@ cell factor_vm::frame_scan(stack_frame *frame)
 				return F;
 			else
 			{
-				char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
+				char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
 				char *quot_xt = (char *)(frame_code(frame) + 1);
 
 				return tag_fixnum(quot_code_offset_to_scan(
@@ -135,11 +135,12 @@ namespace
 {
 
 struct stack_frame_accumulator {
+	factor_vm *myvm;
 	growable_array frames;
 
-	stack_frame_accumulator(factor_vm *vm) : frames(vm) {} 
+	explicit stack_frame_accumulator(factor_vm *myvm_) : myvm(myvm_), frames(myvm_) {} 
 
-	void operator()(stack_frame *frame, factor_vm *myvm)
+	void operator()(stack_frame *frame)
 	{
 		gc_root<object> executing(myvm->frame_executing(frame),myvm);
 		gc_root<object> scan(myvm->frame_scan(frame),myvm);
@@ -204,9 +205,9 @@ void factor_vm::primitive_set_innermost_stack_frame_quot()
 	jit_compile(quot.value(),true);
 
 	stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
-	cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
+	cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt;
 	inner->xt = quot->xt;
-	FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
+	FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
 }
 
 /* called before entry into Factor code. */
diff --git a/vm/callstack.hpp b/vm/callstack.hpp
index 1cfe9a763e..27bf7dda7a 100755
--- a/vm/callstack.hpp
+++ b/vm/callstack.hpp
@@ -10,7 +10,7 @@ VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *
 
 /* This is a little tricky. The iterator may allocate memory, so we
 keep the callstack in a GC root and use relative offsets */
-template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
+template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)
 {
 	gc_root<callstack> stack(stack_,this);
 	fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
@@ -19,38 +19,19 @@ template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stac
 	{
 		stack_frame *frame = stack->frame_at(frame_offset);
 		frame_offset -= frame->size;
-		iterator(frame,this);
+		iterator(frame);
 	}
 }
 
-template<typename TYPE> void factor_vm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
+template<typename Iterator> void factor_vm::iterate_callstack(cell top, cell bottom, Iterator &iterator)
 {
 	stack_frame *frame = (stack_frame *)bottom - 1;
 
 	while((cell)frame >= top)
 	{
-		iterator(frame,this);
+		iterator(frame);
 		frame = frame_successor(frame);
 	}
 }
 
-/* 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. */
-struct factor_vm;
-inline void factor_vm::do_slots(cell obj, void (* iter)(cell *,factor_vm*))
-{
-	cell scan = obj;
-	cell payload_start = binary_payload_start((object *)obj);
-	cell end = obj + payload_start;
-
-	scan += sizeof(cell);
-
-	while(scan < end)
-	{
-		iter((cell *)scan,this);
-		scan += sizeof(cell);
-	}
-}
-
 }
diff --git a/vm/code_block.cpp b/vm/code_block.cpp
index 4179e30771..54fd455ae4 100755
--- a/vm/code_block.cpp
+++ b/vm/code_block.cpp
@@ -188,7 +188,7 @@ cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block
 #undef ARG
 }
 
-void factor_vm::iterate_relocations(code_block *compiled, relocation_iterator iter)
+template<typename Iterator> void factor_vm::iterate_relocations(code_block *compiled, Iterator &iter)
 {
 	if(compiled->relocation != F)
 	{
@@ -200,7 +200,7 @@ void factor_vm::iterate_relocations(code_block *compiled, relocation_iterator it
 		for(cell i = 0; i < length; i++)
 		{
 			relocation_entry rel = relocation->data<relocation_entry>()[i];
-			(this->*iter)(rel,index,compiled);
+			iter(rel,index,compiled);
 			index += number_of_parameters(relocation_type_of(rel));			
 		}
 	}
@@ -270,54 +270,51 @@ void factor_vm::store_address_in_code_block(cell klass, cell offset, fixnum abso
 	}
 }
 
-void factor_vm::update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
-{
-	if(relocation_type_of(rel) == RT_IMMEDIATE)
-	{
-		cell offset = relocation_offset_of(rel) + (cell)(compiled + 1);
-		array *literals = untag<array>(compiled->literals);
-		fixnum absolute_value = array_nth(literals,index);
-		store_address_in_code_block(relocation_class_of(rel),offset,absolute_value);
-	}
-}
+struct literal_references_updater {
+	factor_vm *myvm;
 
-void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm)
-{
-	return myvm->update_literal_references_step(rel,index,compiled);
-}
+	explicit literal_references_updater(factor_vm *myvm_) : myvm(myvm_) {}
+
+	void operator()(relocation_entry rel, cell index, code_block *compiled)
+	{
+		if(myvm->relocation_type_of(rel) == RT_IMMEDIATE)
+		{
+			cell offset = myvm->relocation_offset_of(rel) + (cell)(compiled + 1);
+			array *literals = myvm->untag<array>(compiled->literals);
+			fixnum absolute_value = array_nth(literals,index);
+			myvm->store_address_in_code_block(myvm->relocation_class_of(rel),offset,absolute_value);
+		}
+	}
+};
 
 /* Update pointers to literals from compiled code. */
 void factor_vm::update_literal_references(code_block *compiled)
 {
 	if(!compiled->needs_fixup)
 	{
-		iterate_relocations(compiled,&factor_vm::update_literal_references_step);
+		literal_references_updater updater(this);
+		iterate_relocations(compiled,updater);
 		flush_icache_for(compiled);
 	}
 }
 
 /* Copy all literals referenced from a code block to newspace. Only for
 aging and nursery collections */
-void factor_vm::copy_literal_references(code_block *compiled)
+void factor_vm::trace_literal_references(code_block *compiled)
 {
-	if(collecting_gen >= compiled->last_scan)
+	if(current_gc->collecting_gen >= compiled->last_scan)
 	{
-		if(collecting_accumulation_gen_p())
-			compiled->last_scan = collecting_gen;
+		if(current_gc->collecting_accumulation_gen_p())
+			compiled->last_scan = current_gc->collecting_gen;
 		else
-			compiled->last_scan = collecting_gen + 1;
+			compiled->last_scan = current_gc->collecting_gen + 1;
 
-		/* initialize chase pointer */
-		cell scan = newspace->here;
+		trace_handle(&compiled->literals);
+		trace_handle(&compiled->relocation);
 
-		copy_handle(&compiled->literals);
-		copy_handle(&compiled->relocation);
-
-		/* do some tracing so that all reachable literals are now
-		at their final address */
-		copy_reachable_objects(scan,&newspace->here);
-
-		update_literal_references(compiled);
+		/* once we finish tracing, re-visit this code block and update
+		literals */
+		current_gc->dirty_code_blocks.insert(compiled);
 	}
 }
 
@@ -336,22 +333,17 @@ void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_
 				    compute_relocation(rel,index,compiled));
 }
 
-void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm)
-{
-	return myvm->relocate_code_block_step(rel,index,compiled);
-}
+struct word_references_updater {
+	factor_vm *myvm;
 
-void factor_vm::update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
-{
-	relocation_type type = relocation_type_of(rel);
-	if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
-		relocate_code_block_step(rel,index,compiled);
-}
-
-void update_word_references_step(relocation_entry rel, cell index, code_block *compiled, factor_vm *myvm)
-{
-	return myvm->update_word_references_step(rel,index,compiled);
-}
+	explicit word_references_updater(factor_vm *myvm_) : myvm(myvm_) {}
+	void operator()(relocation_entry rel, cell index, code_block *compiled)
+	{
+		relocation_type type = myvm->relocation_type_of(rel);
+		if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
+			myvm->relocate_code_block_step(rel,index,compiled);
+	}
+};
 
 /* Relocate new code blocks completely; updating references to literals,
 dlsyms, and words. For all other words in the code heap, we only need
@@ -372,27 +364,12 @@ void factor_vm::update_word_references(code_block *compiled)
 		code->heap_free(compiled);
 	else
 	{
-		iterate_relocations(compiled,&factor_vm::update_word_references_step);
+		word_references_updater updater(this);
+		iterate_relocations(compiled,updater);
 		flush_icache_for(compiled);
 	}
 }
 
-void update_word_references(code_block *compiled, factor_vm *myvm)
-{
-	return myvm->update_word_references(compiled);
-}
-
-void factor_vm::update_literal_and_word_references(code_block *compiled)
-{
-	update_literal_references(compiled);
-	update_word_references(compiled);
-}
-
-void update_literal_and_word_references(code_block *compiled, factor_vm *myvm)
-{
-	return myvm->update_literal_and_word_references(compiled);
-}
-
 void factor_vm::check_code_address(cell address)
 {
 #ifdef FACTOR_DEBUG
@@ -411,29 +388,30 @@ void factor_vm::mark_code_block(code_block *compiled)
 
 	code->mark_block(compiled);
 
-	copy_handle(&compiled->literals);
-	copy_handle(&compiled->relocation);
+	trace_handle(&compiled->literals);
+	trace_handle(&compiled->relocation);
 }
 
-void factor_vm::mark_stack_frame_step(stack_frame *frame)
-{
-	mark_code_block(frame_code(frame));
-}
+struct stack_frame_marker {
+	factor_vm *myvm;
 
-void mark_stack_frame_step(stack_frame *frame, factor_vm *myvm)
-{
-	return myvm->mark_stack_frame_step(frame);
-}
+	explicit stack_frame_marker(factor_vm *myvm_) : myvm(myvm_) {}
+	void operator()(stack_frame *frame)
+	{
+		myvm->mark_code_block(myvm->frame_code(frame));
+	}
+};
 
 /* Mark code blocks executing in currently active stack frames. */
 void factor_vm::mark_active_blocks(context *stacks)
 {
-	if(collecting_gen == data->tenured())
+	if(current_gc->collecting_tenured_p())
 	{
 		cell top = (cell)stacks->callstack_top;
 		cell bottom = (cell)stacks->callstack_bottom;
 
-		iterate_callstack(top,bottom,factor::mark_stack_frame_step);
+		stack_frame_marker marker(this);
+		iterate_callstack(top,bottom,marker);
 	}
 }
 
@@ -460,18 +438,32 @@ void factor_vm::mark_object_code_block(object *object)
 	case CALLSTACK_TYPE:
 		{
 			callstack *stack = (callstack *)object;
-			iterate_callstack_object(stack,factor::mark_stack_frame_step);
+			stack_frame_marker marker(this);
+			iterate_callstack_object(stack,marker);
 			break;
 		}
 	}
 }
 
+struct code_block_relocator {
+	factor_vm *myvm;
+
+	explicit code_block_relocator(factor_vm *myvm_) : myvm(myvm_) {}
+
+	void operator()(relocation_entry rel, cell index, code_block *compiled)
+	{
+		myvm->relocate_code_block_step(rel,index,compiled);
+	}
+
+};
+
 /* Perform all fixups on a code block */
 void factor_vm::relocate_code_block(code_block *compiled)
 {
 	compiled->last_scan = data->nursery();
 	compiled->needs_fixup = false;
-	iterate_relocations(compiled,&factor_vm::relocate_code_block_step);
+	code_block_relocator relocator(this);
+	iterate_relocations(compiled,relocator);
 	flush_icache_for(compiled);
 }
 
diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp
index 49b538c0ad..b45b2ac49f 100755
--- a/vm/code_heap.cpp
+++ b/vm/code_heap.cpp
@@ -28,31 +28,37 @@ void factor_vm::jit_compile_word(cell word_, cell def_, bool relocate)
 	if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
 }
 
-/* Apply a function to every code block */
-void factor_vm::iterate_code_heap(code_heap_iterator iter)
-{
-	heap_block *scan = code->first_block();
+struct literal_reference_tracer {
+	factor_vm *myvm;
 
-	while(scan)
+	explicit literal_reference_tracer(factor_vm *myvm_) : myvm(myvm_) {}
+	void operator()(code_block *compiled)
 	{
-		if(scan->status != B_FREE)
-			(this->*iter)((code_block *)scan);
-		scan = code->next_block(scan);
+		myvm->trace_literal_references(compiled);
 	}
-}
+};
 
 /* Copy literals referenced from all code blocks to newspace. Only for
 aging and nursery collections */
-void factor_vm::copy_code_heap_roots()
+void factor_vm::trace_code_heap_roots()
 {
-	iterate_code_heap(&factor_vm::copy_literal_references);
+	code_heap_scans++;
+
+	literal_reference_tracer tracer(this);
+	iterate_code_heap(tracer);
+
+	if(current_gc->collecting_accumulation_gen_p())
+		last_code_heap_scan = current_gc->collecting_gen;
+	else
+		last_code_heap_scan = current_gc->collecting_gen + 1;
 }
 
 /* Update pointers to words referenced from all code blocks. Only after
 defining a new word. */
 void factor_vm::update_code_heap_words()
 {
-	iterate_code_heap(&factor_vm::update_word_references);
+	word_updater updater(this);
+	iterate_code_heap(updater);
 }
 
 void factor_vm::primitive_modify_code_heap()
@@ -122,18 +128,19 @@ code_block *factor_vm::forward_xt(code_block *compiled)
 	return (code_block *)forwarding[compiled];
 }
 
-void factor_vm::forward_frame_xt(stack_frame *frame)
-{
-	cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
-	code_block *forwarded = forward_xt(frame_code(frame));
-	frame->xt = forwarded->xt();
-	FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
-}
+struct xt_forwarder {
+	factor_vm *myvm;
 
-void forward_frame_xt(stack_frame *frame,factor_vm *myvm)
-{
-	return myvm->forward_frame_xt(frame);
-}
+	explicit xt_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
+
+	void operator()(stack_frame *frame)
+	{
+		cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)myvm->frame_code(frame);
+		code_block *forwarded = myvm->forward_xt(myvm->frame_code(frame));
+		frame->xt = forwarded->xt();
+		FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)forwarded + offset);
+	}
+};
 
 void factor_vm::forward_object_xts()
 {
@@ -166,7 +173,8 @@ void factor_vm::forward_object_xts()
 		case CALLSTACK_TYPE:
 			{
 				callstack *stack = untag<callstack>(obj);
-				iterate_callstack_object(stack,factor::forward_frame_xt);
+				xt_forwarder forwarder(this);
+				iterate_callstack_object(stack,forwarder);
 			}
 			break;
 		default:
@@ -212,8 +220,8 @@ do this before saving a deployed image and exiting, so performaance is not
 critical here */
 void factor_vm::compact_code_heap()
 {
-	/* Free all unreachable code blocks */
-	gc();
+	/* Free all unreachable code blocks, don't trace contexts */
+	garbage_collection(data->tenured(),false,false,0);
 
 	/* Figure out where the code heap blocks are going to end up */
 	cell size = code->compute_heap_forwarding(forwarding);
diff --git a/vm/code_heap.hpp b/vm/code_heap.hpp
index df5f14a482..a746d7a445 100755
--- a/vm/code_heap.hpp
+++ b/vm/code_heap.hpp
@@ -8,4 +8,14 @@ inline void factor_vm::check_code_pointer(cell ptr)
 #endif
 }
 
+struct word_updater {
+	factor_vm *myvm;
+
+	explicit word_updater(factor_vm *myvm_) : myvm(myvm_) {}
+	void operator()(code_block *compiled)
+	{
+		myvm->update_word_references(compiled);
+	}
+};
+
 }
diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index 18743c53ba..ea70a7ba6f 100644
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -44,7 +44,6 @@ struct context {
 DEFPUSHPOP(d,ds)
 DEFPUSHPOP(r,rs)
 
-struct factor_vm;
 VM_C_API void nest_stacks(factor_vm *vm);
 VM_C_API void unnest_stacks(factor_vm *vm);
 
diff --git a/vm/cpu-arm.hpp b/vm/cpu-arm.hpp
index 235677b274..b08e76382c 100644
--- a/vm/cpu-arm.hpp
+++ b/vm/cpu-arm.hpp
@@ -6,7 +6,7 @@ namespace factor
 register cell ds asm("r5");
 register cell rs asm("r6");
 
-#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1)
+#define FRAME_RETURN_ADDRESS(frame,vm) *(XT *)(vm->frame_successor(frame) + 1)
 
 void c_to_factor(cell quot);
 void set_callstack(stack_frame *to, stack_frame *from, cell length, void *memcpy);
diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp
index 9074bc1a71..85585aeda6 100644
--- a/vm/cpu-x86.hpp
+++ b/vm/cpu-x86.hpp
@@ -3,7 +3,7 @@
 namespace factor
 {
 
-#define FRAME_RETURN_ADDRESS(frame) *(void **)(frame_successor(frame) + 1)
+#define FRAME_RETURN_ADDRESS(frame,vm) *(void **)(vm->frame_successor(frame) + 1)
 
 inline static void flush_icache(cell start, cell len) {}
 
diff --git a/vm/data_gc.cpp b/vm/data_gc.cpp
index d23caa798f..66dc2d8c04 100755
--- a/vm/data_gc.cpp
+++ b/vm/data_gc.cpp
@@ -5,19 +5,29 @@ namespace factor
 
 void factor_vm::init_data_gc()
 {
-	performing_gc = false;
 	last_code_heap_scan = data->nursery();
-	collecting_aging_again = false;
 }
 
+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_),
+	start_time(current_micros()) { }
+
+gc_state::~gc_state() { }
+
+/* If a generation fills up, throw this error. It is caught in garbage_collection() */
+struct generation_full_condition { };
+
 /* Given a pointer to oldspace, copy it to newspace */
 object *factor_vm::copy_untagged_object_impl(object *pointer, cell size)
 {
-	if(newspace->here + size >= newspace->end)
-		longjmp(gc_jmp,1);
-	object *newpointer = allot_zone(newspace,size);
+	if(current_gc->newspace->here + size >= current_gc->newspace->end)
+		throw generation_full_condition();
 
-	gc_stats *s = &stats[collecting_gen];
+	object *newpointer = allot_zone(current_gc->newspace,size);
+
+	gc_stats *s = &stats[current_gc->collecting_gen];
 	s->object_count++;
 	s->bytes_copied += size;
 
@@ -34,13 +44,13 @@ object *factor_vm::copy_object_impl(object *untagged)
 
 bool factor_vm::should_copy_p(object *untagged)
 {
-	if(in_zone(newspace,untagged))
+	if(in_zone(current_gc->newspace,untagged))
 		return false;
-	if(collecting_gen == data->tenured())
+	if(current_gc->collecting_tenured_p())
 		return true;
-	else if(data->have_aging_p() && collecting_gen == data->aging())
+	else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
 		return !in_zone(&data->generations[data->tenured()],untagged);
-	else if(collecting_gen == data->nursery())
+	else if(current_gc->collecting_nursery_p())
 		return in_zone(&nursery,untagged);
 	else
 	{
@@ -68,16 +78,16 @@ object *factor_vm::resolve_forwarding(object *untagged)
 	}
 }
 
-template <typename TYPE> TYPE *factor_vm::copy_untagged_object(TYPE *untagged)
+template<typename Type> Type *factor_vm::copy_untagged_object(Type *untagged)
 {
 	check_data_pointer(untagged);
 
 	if(untagged->h.forwarding_pointer_p())
-		untagged = (TYPE *)resolve_forwarding(untagged->h.forwarding_pointer());
+		untagged = (Type *)resolve_forwarding(untagged->h.forwarding_pointer());
 	else
 	{
 		untagged->h.check_header();
-		untagged = (TYPE *)copy_object_impl(untagged);
+		untagged = (Type *)copy_object_impl(untagged);
 	}
 
 	return untagged;
@@ -88,7 +98,7 @@ cell factor_vm::copy_object(cell pointer)
 	return RETAG(copy_untagged_object(untag<object>(pointer)),TAG(pointer));
 }
 
-void factor_vm::copy_handle(cell *handle)
+void factor_vm::trace_handle(cell *handle)
 {
 	cell pointer = *handle;
 
@@ -102,7 +112,7 @@ void factor_vm::copy_handle(cell *handle)
 }
 
 /* Scan all the objects in the card */
-void factor_vm::copy_card(card *ptr, cell gen, cell here)
+void factor_vm::trace_card(card *ptr, cell gen, cell here)
 {
 	cell card_scan = card_to_addr(ptr) + card_offset(ptr);
 	cell card_end = card_to_addr(ptr + 1);
@@ -115,7 +125,7 @@ void factor_vm::copy_card(card *ptr, cell gen, cell here)
 	cards_scanned++;
 }
 
-void factor_vm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
+void factor_vm::trace_card_deck(card_deck *deck, cell gen, card mask, card unmask)
 {
 	card *first_card = deck_to_card(deck);
 	card *last_card = deck_to_card(deck + 1);
@@ -136,7 +146,7 @@ void factor_vm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask
 			{
 				if(ptr[card] & mask)
 				{
-					copy_card(&ptr[card],gen,here);
+					trace_card(&ptr[card],gen,here);
 					ptr[card] &= ~unmask;
 				}
 			}
@@ -147,7 +157,7 @@ void factor_vm::copy_card_deck(card_deck *deck, cell gen, card mask, card unmask
 }
 
 /* Copy all newspace objects referenced from marked cards to the destination */
-void factor_vm::copy_gen_cards(cell gen)
+void factor_vm::trace_generation_cards(cell gen)
 {
 	card_deck *first_deck = addr_to_deck(data->generations[gen].start);
 	card_deck *last_deck = addr_to_deck(data->generations[gen].end);
@@ -156,7 +166,7 @@ void factor_vm::copy_gen_cards(cell gen)
 
 	/* if we are collecting the nursery, we care about old->nursery pointers
 	but not old->aging pointers */
-	if(collecting_gen == data->nursery())
+	if(current_gc->collecting_nursery_p())
 	{
 		mask = card_points_to_nursery;
 
@@ -171,16 +181,16 @@ void factor_vm::copy_gen_cards(cell gen)
 			unmask = card_mark_mask;
 		else
 		{
-			critical_error("bug in copy_gen_cards",gen);
+			critical_error("bug in trace_generation_cards",gen);
 			return;
 		}
 	}
 	/* if we are collecting aging space into tenured space, we care about
 	all old->nursery and old->aging pointers. no old->aging pointers can
 	remain */
-	else if(data->have_aging_p() && collecting_gen == data->aging())
+	else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
 	{
-		if(collecting_aging_again)
+		if(current_gc->collecting_aging_again)
 		{
 			mask = card_points_to_aging;
 			unmask = card_mark_mask;
@@ -196,7 +206,7 @@ void factor_vm::copy_gen_cards(cell gen)
 	}
 	else
 	{
-		critical_error("bug in copy_gen_cards",gen);
+		critical_error("bug in trace_generation_cards",gen);
 		return;
 	}
 
@@ -206,7 +216,7 @@ void factor_vm::copy_gen_cards(cell gen)
 	{
 		if(*ptr & mask)
 		{
-			copy_card_deck(ptr,gen,mask,unmask);
+			trace_card_deck(ptr,gen,mask,unmask);
 			*ptr &= ~unmask;
 		}
 	}
@@ -214,36 +224,36 @@ void factor_vm::copy_gen_cards(cell gen)
 
 /* Scan cards in all generations older than the one being collected, copying
 old->new references */
-void factor_vm::copy_cards()
+void factor_vm::trace_cards()
 {
 	u64 start = current_micros();
 
 	cell i;
-	for(i = collecting_gen + 1; i < data->gen_count; i++)
-		copy_gen_cards(i);
+	for(i = current_gc->collecting_gen + 1; i < data->gen_count; i++)
+		trace_generation_cards(i);
 
 	card_scan_time += (current_micros() - start);
 }
 
 /* Copy all tagged pointers in a range of memory */
-void factor_vm::copy_stack_elements(segment *region, cell top)
+void factor_vm::trace_stack_elements(segment *region, cell top)
 {
 	cell ptr = region->start;
 
 	for(; ptr <= top; ptr += sizeof(cell))
-		copy_handle((cell*)ptr);
+		trace_handle((cell*)ptr);
 }
 
-void factor_vm::copy_registered_locals()
+void factor_vm::trace_registered_locals()
 {
 	std::vector<cell>::const_iterator iter = gc_locals.begin();
 	std::vector<cell>::const_iterator end = gc_locals.end();
 
 	for(; iter < end; iter++)
-		copy_handle((cell *)(*iter));
+		trace_handle((cell *)(*iter));
 }
 
-void factor_vm::copy_registered_bignums()
+void factor_vm::trace_registered_bignums()
 {
 	std::vector<cell>::const_iterator iter = gc_bignums.begin();
 	std::vector<cell>::const_iterator end = gc_bignums.end();
@@ -267,38 +277,38 @@ void factor_vm::copy_registered_bignums()
 
 /* Copy roots over at the start of GC, namely various constants, stacks,
 the user environment and extra roots registered by local_roots.hpp */
-void factor_vm::copy_roots()
+void factor_vm::trace_roots()
 {
-	copy_handle(&T);
-	copy_handle(&bignum_zero);
-	copy_handle(&bignum_pos_one);
-	copy_handle(&bignum_neg_one);
+	trace_handle(&T);
+	trace_handle(&bignum_zero);
+	trace_handle(&bignum_pos_one);
+	trace_handle(&bignum_neg_one);
 
-	copy_registered_locals();
-	copy_registered_bignums();
-
-	if(!performing_compaction)
-	{
-		save_stacks();
-		context *stacks = stack_chain;
-
-		while(stacks)
-		{
-			copy_stack_elements(stacks->datastack_region,stacks->datastack);
-			copy_stack_elements(stacks->retainstack_region,stacks->retainstack);
-
-			copy_handle(&stacks->catchstack_save);
-			copy_handle(&stacks->current_callback_save);
-
-			mark_active_blocks(stacks);
-
-			stacks = stacks->next;
-		}
-	}
+	trace_registered_locals();
+	trace_registered_bignums();
 
 	int i;
 	for(i = 0; i < USER_ENV; i++)
-		copy_handle(&userenv[i]);
+		trace_handle(&userenv[i]);
+}
+
+void factor_vm::trace_contexts()
+{
+	save_stacks();
+	context *stacks = stack_chain;
+
+	while(stacks)
+	{
+		trace_stack_elements(stacks->datastack_region,stacks->datastack);
+		trace_stack_elements(stacks->retainstack_region,stacks->retainstack);
+
+		trace_handle(&stacks->catchstack_save);
+		trace_handle(&stacks->current_callback_save);
+
+		mark_active_blocks(stacks);
+
+		stacks = stacks->next;
+	}
 }
 
 cell factor_vm::copy_next_from_nursery(cell scan)
@@ -341,8 +351,8 @@ cell factor_vm::copy_next_from_aging(cell scan)
 		cell tenured_start = data->generations[data->tenured()].start;
 		cell tenured_end = data->generations[data->tenured()].end;
 
-		cell newspace_start = newspace->start;
-		cell newspace_end = newspace->end;
+		cell newspace_start = current_gc->newspace->start;
+		cell newspace_end = current_gc->newspace->end;
 
 		for(; obj < end; obj++)
 		{
@@ -370,8 +380,8 @@ cell factor_vm::copy_next_from_tenured(cell scan)
 	{
 		obj++;
 
-		cell newspace_start = newspace->start;
-		cell newspace_end = newspace->end;
+		cell newspace_start = current_gc->newspace->start;
+		cell newspace_end = current_gc->newspace->end;
 
 		for(; obj < end; obj++)
 		{
@@ -393,179 +403,228 @@ cell factor_vm::copy_next_from_tenured(cell scan)
 
 void factor_vm::copy_reachable_objects(cell scan, cell *end)
 {
-	if(collecting_gen == data->nursery())
+	if(current_gc->collecting_nursery_p())
 	{
 		while(scan < *end)
 			scan = copy_next_from_nursery(scan);
 	}
-	else if(data->have_aging_p() && collecting_gen == data->aging())
+	else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
 	{
 		while(scan < *end)
 			scan = copy_next_from_aging(scan);
 	}
-	else if(collecting_gen == data->tenured())
+	else if(current_gc->collecting_tenured_p())
 	{
 		while(scan < *end)
 			scan = copy_next_from_tenured(scan);
 	}
 }
 
+void factor_vm::update_code_heap_roots()
+{
+	if(current_gc->collecting_gen >= last_code_heap_scan)
+	{
+		code_heap_scans++;
+
+		trace_code_heap_roots();
+
+		if(current_gc->collecting_accumulation_gen_p())
+			last_code_heap_scan = current_gc->collecting_gen;
+		else
+			last_code_heap_scan = current_gc->collecting_gen + 1;
+	}
+}
+
+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);
+	last_code_heap_scan = current_gc->collecting_gen;
+}
+
+void factor_vm::update_dirty_code_blocks()
+{
+	std::set<code_block *> dirty_code_blocks = current_gc->dirty_code_blocks;
+	std::set<code_block *>::const_iterator iter = dirty_code_blocks.begin();
+	std::set<code_block *>::const_iterator end = dirty_code_blocks.end();
+
+	for(; iter != end; iter++)
+		update_literal_references(*iter);
+
+	dirty_code_blocks.clear();
+}
+
 /* Prepare to start copying reachable objects into an unused zone */
 void factor_vm::begin_gc(cell requested_bytes)
 {
-	if(growing_data_heap)
+	if(current_gc->growing_data_heap)
 	{
-		if(collecting_gen != data->tenured())
-			critical_error("Invalid parameters to begin_gc",0);
+		assert(current_gc->collecting_tenured_p());
 
-		old_data_heap = data;
-		set_data_heap(grow_data_heap(old_data_heap,requested_bytes));
-		newspace = &data->generations[data->tenured()];
+		current_gc->old_data_heap = data;
+		set_data_heap(grow_data_heap(current_gc->old_data_heap,requested_bytes));
+		current_gc->newspace = &data->generations[data->tenured()];
 	}
-	else if(collecting_accumulation_gen_p())
+	else if(current_gc->collecting_accumulation_gen_p())
 	{
 		/* when collecting one of these generations, rotate it
 		with the semispace */
-		zone z = data->generations[collecting_gen];
-		data->generations[collecting_gen] = data->semispaces[collecting_gen];
-		data->semispaces[collecting_gen] = z;
-		reset_generation(collecting_gen);
-		newspace = &data->generations[collecting_gen];
-		clear_cards(collecting_gen,collecting_gen);
-		clear_decks(collecting_gen,collecting_gen);
-		clear_allot_markers(collecting_gen,collecting_gen);
+		zone z = data->generations[current_gc->collecting_gen];
+		data->generations[current_gc->collecting_gen] = data->semispaces[current_gc->collecting_gen];
+		data->semispaces[current_gc->collecting_gen] = z;
+		reset_generation(current_gc->collecting_gen);
+		current_gc->newspace = &data->generations[current_gc->collecting_gen];
+		clear_cards(current_gc->collecting_gen,current_gc->collecting_gen);
+		clear_decks(current_gc->collecting_gen,current_gc->collecting_gen);
+		clear_allot_markers(current_gc->collecting_gen,current_gc->collecting_gen);
 	}
 	else
 	{
 		/* when collecting a younger generation, we copy
 		reachable objects to the next oldest generation,
 		so we set the newspace so the next generation. */
-		newspace = &data->generations[collecting_gen + 1];
+		current_gc->newspace = &data->generations[current_gc->collecting_gen + 1];
 	}
 }
 
-void factor_vm::end_gc(cell gc_elapsed)
+void factor_vm::end_gc()
 {
-	gc_stats *s = &stats[collecting_gen];
 
+	gc_stats *s = &stats[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;
 
-	if(growing_data_heap)
-	{
-		delete old_data_heap;
-		old_data_heap = NULL;
-		growing_data_heap = false;
-	}
+	if(current_gc->growing_data_heap)
+		delete current_gc->old_data_heap;
 
-	if(collecting_accumulation_gen_p())
-	{
-		/* all younger generations except are now empty.
-		if collecting_gen == data->nursery() here, we only have 1 generation;
-		old-school Cheney collector */
-		if(collecting_gen != data->nursery())
-			reset_generations(data->nursery(),collecting_gen - 1);
-	}
-	else if(collecting_gen == data->nursery())
+	if(current_gc->collecting_nursery_p())
 	{
 		nursery.here = nursery.start;
 	}
+	else if(current_gc->collecting_accumulation_gen_p())
+	{
+		reset_generations(data->nursery(),current_gc->collecting_gen - 1);
+	}
 	else
 	{
 		/* all generations up to and including the one
 		collected are now empty */
-		reset_generations(data->nursery(),collecting_gen);
+		reset_generations(data->nursery(),current_gc->collecting_gen);
 	}
-
-	collecting_aging_again = false;
 }
 
 /* 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 gen,bool growing_data_heap_,cell requested_bytes)
+void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_, bool trace_contexts_, cell requested_bytes)
 {
 	if(gc_off)
 	{
-		critical_error("GC disabled",gen);
+		critical_error("GC disabled",collecting_gen_);
 		return;
 	}
 
-	u64 start = current_micros();
+	current_gc = new gc_state(data,growing_data_heap_,collecting_gen_);
 
-	performing_gc = true;
-	growing_data_heap = growing_data_heap_;
-	collecting_gen = gen;
-
-	/* we come back here if a generation is full */
-	if(setjmp(gc_jmp))
+	/* Keep trying to GC higher and higher generations until we don't run out
+	of space */
+	for(;;)
 	{
-		/* We have no older generations we can try collecting, so we
-		resort to growing the data heap */
-		if(collecting_gen == data->tenured())
+		try
 		{
-			growing_data_heap = true;
+			begin_gc(requested_bytes);
 
-			/* see the comment in unmark_marked() */
-			code->unmark_marked();
+			/* Initialize chase pointer */
+			cell scan = current_gc->newspace->here;
+
+			/* Trace objects referenced from global environment */
+			trace_roots();
+
+			/* Trace objects referenced from stacks, unless we're doing
+			save-image-and-exit in which case stack objects are irrelevant */
+			if(trace_contexts_) trace_contexts();
+
+			/* Trace objects referenced from older generations */
+			trace_cards();
+
+			/* On minor GC, trace code heap roots if it has pointers
+			to this generation or younger. Otherwise, tracing data heap objects
+			will mark all reachable code blocks, and we free the unmarked ones
+			after. */
+			if(!current_gc->collecting_tenured_p() && current_gc->collecting_gen >= last_code_heap_scan)
+			{
+				update_code_heap_roots();
+			}
+
+			/* do some copying -- this is where most of the work is done */
+			copy_reachable_objects(scan,&current_gc->newspace->here);
+
+			/* On minor GC, update literal references in code blocks, now that all
+			data heap objects are in their final location. On a major GC,
+			free all code blocks that did not get marked during tracing. */
+			if(current_gc->collecting_tenured_p())
+				free_unmarked_code_blocks();
+			else
+				update_dirty_code_blocks();
+
+			/* GC completed without any generations filling up; finish up */
+			break;
 		}
-		/* we try collecting aging space twice before going on to
-		collect tenured */
-		else if(data->have_aging_p()
-			&& collecting_gen == data->aging()
-			&& !collecting_aging_again)
+		catch(const generation_full_condition &c)
 		{
-			collecting_aging_again = true;
-		}
-		/* Collect the next oldest generation */
-		else
-		{
-			collecting_gen++;
+			/* 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())
+			{
+				current_gc->growing_data_heap = true;
+
+				/* see the comment in unmark_marked() */
+				code->unmark_marked();
+			}
+			/* we try collecting aging space twice before going on to
+			collect tenured */
+			else if(data->have_aging_p()
+				&& current_gc->collecting_gen == data->aging()
+				&& !current_gc->collecting_aging_again)
+			{
+				current_gc->collecting_aging_again = true;
+			}
+			/* Collect the next oldest generation */
+			else
+			{
+				current_gc->collecting_gen++;
+			}
 		}
 	}
 
-	begin_gc(requested_bytes);
+	end_gc();
 
-	/* initialize chase pointer */
-	cell scan = newspace->here;
-
-	/* collect objects referenced from stacks and environment */
-	copy_roots();
-	/* collect objects referenced from older generations */
-	copy_cards();
-
-	/* do some tracing */
-	copy_reachable_objects(scan,&newspace->here);
-
-	/* don't scan code heap unless it has pointers to this
-	generation or younger */
-	if(collecting_gen >= last_code_heap_scan)
-	{
-		code_heap_scans++;
-
-		if(collecting_gen == data->tenured())
-			code->free_unmarked((heap_iterator)&factor_vm::update_literal_and_word_references);
-		else
-			copy_code_heap_roots();
-
-		if(collecting_accumulation_gen_p())
-			last_code_heap_scan = collecting_gen;
-		else
-			last_code_heap_scan = collecting_gen + 1;
-	}
-
-	cell gc_elapsed = (current_micros() - start);
-
-	end_gc(gc_elapsed);
-
-	performing_gc = false;
+	delete current_gc;
+	current_gc = NULL;
 }
 
 void factor_vm::gc()
 {
-	garbage_collection(data->tenured(),false,0);
+	garbage_collection(data->tenured(),false,true,0);
 }
 
 void factor_vm::primitive_gc()
@@ -655,7 +714,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(data->nursery(),false,0);
+	garbage_collection(data->nursery(),false,true,0);
 
 	for(cell i = 0; i < gc_roots_size; i++)
 		gc_locals.pop_back();
@@ -693,7 +752,7 @@ object *factor_vm::allot_object(header header, cell size)
 	{
 		/* If there is insufficient room, collect the nursery */
 		if(nursery.here + allot_buffer_zone + size > nursery.end)
-			garbage_collection(data->nursery(),false,0);
+			garbage_collection(data->nursery(),false,true,0);
 
 		cell h = nursery.here;
 		nursery.here = h + align8(size);
@@ -715,7 +774,7 @@ object *factor_vm::allot_object(header header, cell size)
 		/* If it still won't fit, grow the heap */
 		if(tenured->here + size > tenured->end)
 		{
-			garbage_collection(data->tenured(),true,size);
+			garbage_collection(data->tenured(),true,true,size);
 			tenured = &data->generations[data->tenured()];
 		}
 
diff --git a/vm/data_gc.hpp b/vm/data_gc.hpp
index 5db7aa24a6..3b80fa781a 100755
--- a/vm/data_gc.hpp
+++ b/vm/data_gc.hpp
@@ -10,12 +10,57 @@ struct gc_stats {
 	u64 bytes_copied;
 };
 
+struct gc_state {
+	/* The data heap we're collecting */
+	data_heap *data;
+
+	/* New objects are copied here */
+	zone *newspace;
+
+	/* sometimes we grow the heap */
+	bool growing_data_heap;
+	data_heap *old_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;
+
+	/* A set of code blocks which need to have their literals updated */
+	std::set<code_block *> dirty_code_blocks;
+
+	/* GC start time, for benchmarking */
+	u64 start_time;
+
+	explicit gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_);
+	~gc_state();
+
+	inline bool collecting_nursery_p()
+	{
+		return collecting_gen == data->nursery();
+	}
+
+	inline bool collecting_tenured_p()
+	{
+		return collecting_gen == data->tenured();
+	}
+
+	inline bool collecting_accumulation_gen_p()
+	{
+		return ((data->have_aging_p()
+			 && collecting_gen == data->aging()
+			 && !collecting_aging_again)
+			|| collecting_gen == data->tenured());
+	}
+};
+
 /* We leave this many bytes free at the top of the nursery so that inline
 allocation (which does not call GC because of possible roots in volatile
 registers) does not run out of memory */
 static const cell allot_buffer_zone = 1024;
 
-struct factor_vm;
 VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
 
 }
diff --git a/vm/data_heap.cpp b/vm/data_heap.cpp
index 1745d7721f..20952736d2 100755
--- a/vm/data_heap.cpp
+++ b/vm/data_heap.cpp
@@ -310,12 +310,12 @@ void factor_vm::primitive_end_scan()
 	gc_off = false;
 }
 
-template<typename TYPE> void factor_vm::each_object(TYPE &functor)
+template<typename Iterator> void factor_vm::each_object(Iterator &iterator)
 {
 	begin_scan();
 	cell obj;
 	while((obj = next_object()) != F)
-		functor(tagged<object>(obj));
+		iterator(tagged<object>(obj));
 	end_scan();
 }
 
@@ -324,13 +324,13 @@ namespace
 
 struct word_counter {
 	cell count;
-	word_counter() : count(0) {}
+	explicit word_counter() : count(0) {}
 	void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) count++; }
 };
 
 struct word_accumulator {
 	growable_array words;
-	word_accumulator(int count,factor_vm *vm) : words(vm,count) {}
+	explicit word_accumulator(int count,factor_vm *vm) : words(vm,count) {}
 	void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) words.add(obj.value()); }
 };
 
diff --git a/vm/data_heap.hpp b/vm/data_heap.hpp
index 88216e3191..820714ab65 100755
--- a/vm/data_heap.hpp
+++ b/vm/data_heap.hpp
@@ -51,7 +51,7 @@ struct data_heap {
 	
 	bool have_aging_p() { return gen_count > 2; }
 
-	data_heap(factor_vm *myvm, cell gen_count, cell young_size, cell aging_size, cell tenured_size);
+	explicit data_heap(factor_vm *myvm, cell gen_count, cell young_size, cell aging_size, cell tenured_size);
 	~data_heap();
 };
 
diff --git a/vm/debug.cpp b/vm/debug.cpp
index 63c6958771..117b35af18 100755
--- a/vm/debug.cpp
+++ b/vm/debug.cpp
@@ -164,34 +164,35 @@ void factor_vm::print_retainstack()
 	print_objects((cell *)rs_bot,(cell *)rs);
 }
 
-void factor_vm::print_stack_frame(stack_frame *frame)
-{
-	print_obj(frame_executing(frame));
-	print_string("\n");
-	print_obj(frame_scan(frame));
-	print_string("\n");
-	print_string("word/quot addr: ");
-	print_cell_hex((cell)frame_executing(frame));
-	print_string("\n");
-	print_string("word/quot xt: ");
-	print_cell_hex((cell)frame->xt);
-	print_string("\n");
-	print_string("return address: ");
-	print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame));
-	print_string("\n");
-}
+struct stack_frame_printer {
+	factor_vm *myvm;
 
-void print_stack_frame(stack_frame *frame, factor_vm *myvm)
-{
-	return myvm->print_stack_frame(frame);
-}
+	explicit stack_frame_printer(factor_vm *myvm_) : myvm(myvm_) {}
+	void operator()(stack_frame *frame)
+	{
+		myvm->print_obj(myvm->frame_executing(frame));
+		print_string("\n");
+		myvm->print_obj(myvm->frame_scan(frame));
+		print_string("\n");
+		print_string("word/quot addr: ");
+		print_cell_hex((cell)myvm->frame_executing(frame));
+		print_string("\n");
+		print_string("word/quot xt: ");
+		print_cell_hex((cell)frame->xt);
+		print_string("\n");
+		print_string("return address: ");
+		print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame,myvm));
+		print_string("\n");
+	}
+};
 
 void factor_vm::print_callstack()
 {
 	print_string("==== CALL STACK:\n");
 	cell bottom = (cell)stack_chain->callstack_bottom;
 	cell top = (cell)stack_chain->callstack_top;
-	iterate_callstack(top,bottom,factor::print_stack_frame);
+	stack_frame_printer printer(this);
+	iterate_callstack(top,bottom,printer);
 }
 
 void factor_vm::dump_cell(cell x)
@@ -263,30 +264,36 @@ void factor_vm::dump_objects(cell type)
 	end_scan();
 }
 
-void factor_vm::find_data_references_step(cell *scan)
-{
-	if(look_for == *scan)
+struct data_references_finder {
+	cell look_for, obj;
+	factor_vm *myvm;
+
+	explicit data_references_finder(cell look_for_, cell obj_, factor_vm *myvm_)
+		: look_for(look_for_), obj(obj_), myvm(myvm_) { }
+
+	void operator()(cell *scan)
 	{
-		print_cell_hex_pad(obj);
-		print_string(" ");
-		print_nested_obj(obj,2);
-		nl();
+		if(look_for == *scan)
+		{
+			print_cell_hex_pad(obj);
+			print_string(" ");
+			myvm->print_nested_obj(obj,2);
+			nl();
+		}
 	}
-}
+};
 
-void find_data_references_step(cell *scan,factor_vm *myvm)
+void factor_vm::find_data_references(cell look_for)
 {
-	return myvm->find_data_references_step(scan);
-}
-
-void factor_vm::find_data_references(cell look_for_)
-{
-	look_for = look_for_;
-
 	begin_scan();
 
+	cell obj;
+
 	while((obj = next_object()) != F)
-		do_slots(UNTAG(obj),factor::find_data_references_step);
+	{
+		data_references_finder finder(look_for,obj,this);
+		do_slots(UNTAG(obj),finder);
+	}
 
 	end_scan();
 }
diff --git a/vm/factor.cpp b/vm/factor.cpp
index 6243da7572..41a2da6f03 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -222,7 +222,7 @@ struct startargs {
 	vm_char **argv;
 };
 
-factor_vm * new_factor_vm()
+factor_vm *new_factor_vm()
 {
 	factor_vm *newvm = new factor_vm;
 	register_vm_with_thread(newvm);
diff --git a/vm/generic_arrays.hpp b/vm/generic_arrays.hpp
index 8e499a928f..f028089964 100644
--- a/vm/generic_arrays.hpp
+++ b/vm/generic_arrays.hpp
@@ -1,7 +1,7 @@
 namespace factor
 {
 
-template<typename T> cell array_capacity(T *array)
+template<typename Array> cell array_capacity(Array *array)
 {
 #ifdef FACTOR_DEBUG
 	assert(array->h.hi_tag() == T::type_number);
@@ -9,31 +9,31 @@ template<typename T> cell array_capacity(T *array)
 	return array->capacity >> TAG_BITS;
 }
 
-template <typename T> cell array_size(cell capacity)
+template<typename Array> cell array_size(cell capacity)
 {
-	return sizeof(T) + capacity * T::element_size;
+	return sizeof(Array) + capacity * Array::element_size;
 }
 
-template <typename T> cell array_size(T *array)
+template<typename Array> cell array_size(Array *array)
 {
-	return array_size<T>(array_capacity(array));
+	return array_size<Array>(array_capacity(array));
 }
 
-template <typename TYPE> TYPE *factor_vm::allot_array_internal(cell capacity)
+template<typename Array> Array *factor_vm::allot_array_internal(cell capacity)
 {
-	TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
+	Array *array = allot<Array>(array_size<Array>(capacity));
 	array->capacity = tag_fixnum(capacity);
 	return array;
 }
 
-template <typename TYPE> bool factor_vm::reallot_array_in_place_p(TYPE *array, cell capacity)
+template<typename Array> bool factor_vm::reallot_array_in_place_p(Array *array, cell capacity)
 {
 	return in_zone(&nursery,array) && capacity <= array_capacity(array);
 }
 
-template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capacity)
+template<typename Array> Array *factor_vm::reallot_array(Array *array_, cell capacity)
 {
-	gc_root<TYPE> array(array_,this);
+	gc_root<Array> array(array_,this);
 
 	if(reallot_array_in_place_p(array.untagged(),capacity))
 	{
@@ -46,11 +46,11 @@ template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capac
 		if(capacity < to_copy)
 			to_copy = capacity;
 			
-		TYPE *new_array = allot_array_internal<TYPE>(capacity);
+		Array *new_array = allot_array_internal<Array>(capacity);
 		
-		memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
-		memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
-		       0,(capacity - to_copy) * TYPE::element_size);
+		memcpy(new_array + 1,array.untagged() + 1,to_copy * Array::element_size);
+		memset((char *)(new_array + 1) + to_copy * Array::element_size,
+		       0,(capacity - to_copy) * Array::element_size);
 		
 		return new_array;
 	}
diff --git a/vm/heap.cpp b/vm/heap.cpp
index 8b0e487b60..5bd8608f3d 100644
--- a/vm/heap.cpp
+++ b/vm/heap.cpp
@@ -208,55 +208,6 @@ void heap::unmark_marked()
 	}
 }
 
-/* After code GC, all referenced code blocks have status set to B_MARKED, so any
-which are allocated and not marked can be reclaimed. */
-void heap::free_unmarked(heap_iterator iter)
-{
-	clear_free_list();
-
-	heap_block *prev = NULL;
-	heap_block *scan = first_block();
-
-	while(scan)
-	{
-		switch(scan->status)
-		{
-		case B_ALLOCATED:
-			if(myvm->secure_gc)
-				memset(scan + 1,0,scan->size - sizeof(heap_block));
-
-			if(prev && prev->status == B_FREE)
-				prev->size += scan->size;
-			else
-			{
-				scan->status = B_FREE;
-				prev = scan;
-			}
-			break;
-		case B_FREE:
-			if(prev && prev->status == B_FREE)
-				prev->size += scan->size;
-			else
-				prev = scan;
-			break;
-		case B_MARKED:
-			if(prev && prev->status == B_FREE)
-				add_to_free_list((free_heap_block *)prev);
-			scan->status = B_ALLOCATED;
-			prev = scan;
-			(myvm->*iter)(scan);
-			break;
-		default:
-			myvm->critical_error("Invalid scan->status",(cell)scan);
-		}
-
-		scan = next_block(scan);
-	}
-
-	if(prev && prev->status == B_FREE)
-		add_to_free_list((free_heap_block *)prev);
-}
-
 /* Compute total sum of sizes of free blocks, and size of largest free block */
 void heap::heap_usage(cell *used, cell *total_free, cell *max_free)
 {
@@ -338,4 +289,21 @@ void heap::compact_heap(unordered_map<heap_block *,char *> &forwarding)
 	}
 }
 
+heap_block *heap::free_allocated(heap_block *prev, heap_block *scan)
+{
+	if(myvm->secure_gc)
+		memset(scan + 1,0,scan->size - sizeof(heap_block));
+
+	if(prev && prev->status == B_FREE)
+	{
+		prev->size += scan->size;
+		return prev;
+	}
+	else
+	{
+		scan->status = B_FREE;
+		return scan;
+	}
+}
+
 }
diff --git a/vm/heap.hpp b/vm/heap.hpp
index c5d170a3d7..2558338f59 100644
--- a/vm/heap.hpp
+++ b/vm/heap.hpp
@@ -9,14 +9,12 @@ struct heap_free_list {
 	free_heap_block *large_blocks;
 };
 
-typedef void (factor_vm::*heap_iterator)(heap_block *compiled);
-
 struct heap {
 	factor_vm *myvm;
 	segment *seg;
 	heap_free_list free;
 
-	heap(factor_vm *myvm, cell size);
+	explicit heap(factor_vm *myvm, cell size);
 
 	inline heap_block *next_block(heap_block *block)
 	{
@@ -48,12 +46,50 @@ struct heap {
 	void heap_free(heap_block *block);
 	void mark_block(heap_block *block);
 	void unmark_marked();
-	void free_unmarked(heap_iterator iter);
 	void heap_usage(cell *used, cell *total_free, cell *max_free);
 	cell heap_size();
 	cell compute_heap_forwarding(unordered_map<heap_block *,char *> &forwarding);
 	void compact_heap(unordered_map<heap_block *,char *> &forwarding);
 
+	heap_block *free_allocated(heap_block *prev, heap_block *scan);
+
+	/* After code GC, all referenced code blocks have status set to B_MARKED, so any
+	which are allocated and not marked can be reclaimed. */
+	template<typename Iterator> void free_unmarked(Iterator &iter)
+	{
+		clear_free_list();
+	
+		heap_block *prev = NULL;
+		heap_block *scan = first_block();
+	
+		while(scan)
+		{
+			switch(scan->status)
+			{
+			case B_ALLOCATED:
+				prev = free_allocated(prev,scan);
+				break;
+			case B_FREE:
+				if(prev && prev->status == B_FREE)
+					prev->size += scan->size;
+				else
+					prev = scan;
+				break;
+			case B_MARKED:
+				if(prev && prev->status == B_FREE)
+					add_to_free_list((free_heap_block *)prev);
+				scan->status = B_ALLOCATED;
+				prev = scan;
+				iter(scan);
+				break;
+			}
+	
+			scan = next_block(scan);
+		}
+	
+		if(prev && prev->status == B_FREE)
+			add_to_free_list((free_heap_block *)prev);
+	}
 };
 
 }
diff --git a/vm/image.cpp b/vm/image.cpp
index e3f7784f4f..bf50b30d4b 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -143,9 +143,7 @@ void factor_vm::primitive_save_image_and_exit()
 	}
 
 	/* do a full GC + code heap compaction */
-	performing_compaction = true;
 	compact_code_heap();
-	performing_compaction = false;
 
 	/* Save the image */
 	if(save_image((vm_char *)(path.untagged() + 1)))
@@ -163,15 +161,10 @@ void factor_vm::data_fixup(cell *cell)
 	*cell += (tenured->start - data_relocation_base);
 }
 
-void data_fixup(cell *cell, factor_vm *myvm)
+template<typename Type> void factor_vm::code_fixup(Type **handle)
 {
-	return myvm->data_fixup(cell);
-}
-
-template <typename TYPE> void factor_vm::code_fixup(TYPE **handle)
-{
-	TYPE *ptr = *handle;
-	TYPE *new_ptr = (TYPE *)(((cell)ptr) + (code->seg->start - code_relocation_base));
+	Type *ptr = *handle;
+	Type *new_ptr = (Type *)(((cell)ptr) + (code->seg->start - code_relocation_base));
 	*handle = new_ptr;
 }
 
@@ -200,22 +193,34 @@ void factor_vm::fixup_alien(alien *d)
 	d->expired = T;
 }
 
-void factor_vm::fixup_stack_frame(stack_frame *frame)
-{
-	code_fixup(&frame->xt);
-	code_fixup(&FRAME_RETURN_ADDRESS(frame));
-}
+struct stack_frame_fixupper {
+	factor_vm *myvm;
 
-void fixup_stack_frame(stack_frame *frame, factor_vm *myvm)
-{
-	return myvm->fixup_stack_frame(frame);
-}
+	explicit stack_frame_fixupper(factor_vm *myvm_) : myvm(myvm_) {}
+	void operator()(stack_frame *frame)
+	{
+		myvm->code_fixup(&frame->xt);
+		myvm->code_fixup(&FRAME_RETURN_ADDRESS(frame,myvm));
+	}
+};
 
 void factor_vm::fixup_callstack_object(callstack *stack)
 {
-	iterate_callstack_object(stack,factor::fixup_stack_frame);
+	stack_frame_fixupper fixupper(this);
+	iterate_callstack_object(stack,fixupper);
 }
 
+struct object_fixupper {
+	factor_vm *myvm;
+
+	explicit object_fixupper(factor_vm *myvm_) : myvm(myvm_) { }
+
+	void operator()(cell *scan)
+	{
+		myvm->data_fixup(scan);
+	}
+};
+
 /* Initialize an object in a newly-loaded image */
 void factor_vm::relocate_object(object *object)
 {
@@ -237,7 +242,8 @@ void factor_vm::relocate_object(object *object)
 	}
 	else
 	{
-		do_slots((cell)object,factor::data_fixup);
+		object_fixupper fixupper(this);
+		do_slots((cell)object,fixupper);
 
 		switch(hi_tag)
 		{
@@ -296,14 +302,21 @@ void factor_vm::fixup_code_block(code_block *compiled)
 	relocate_code_block(compiled);
 }
 
-void fixup_code_block(code_block *compiled, factor_vm *myvm)
-{
-	return myvm->fixup_code_block(compiled);
-}
+struct code_block_fixupper {
+	factor_vm *myvm;
+
+	code_block_fixupper(factor_vm *myvm_) : myvm(myvm_) { }
+
+	void operator()(code_block *compiled)
+	{
+		myvm->fixup_code_block(compiled);
+	}
+};
 
 void factor_vm::relocate_code()
 {
-	iterate_code_heap(&factor_vm::fixup_code_block);
+	code_block_fixupper fixupper(this);
+	iterate_code_heap(fixupper);
 }
 
 /* Read an image file from disk, only done once during startup */
diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp
index d68e76cc6e..e278c0d461 100755
--- a/vm/inline_cache.cpp
+++ b/vm/inline_cache.cpp
@@ -74,7 +74,7 @@ void factor_vm::update_pic_count(cell type)
 struct inline_cache_jit : public jit {
 	fixnum index;
 
-	inline_cache_jit(cell generic_word_,factor_vm *vm) : jit(PIC_TYPE,generic_word_,vm) {};
+	explicit inline_cache_jit(cell generic_word_,factor_vm *vm) : jit(PIC_TYPE,generic_word_,vm) {};
 
 	void emit_check(cell klass);
 	void compile_inline_cache(fixnum index,
diff --git a/vm/jit.hpp b/vm/jit.hpp
index ee626e853f..789f68e22b 100644
--- a/vm/jit.hpp
+++ b/vm/jit.hpp
@@ -12,7 +12,7 @@ struct jit {
 	cell offset;
 	factor_vm *parent_vm;
 
-	jit(cell jit_type, cell owner, factor_vm *vm);
+	explicit jit(cell jit_type, cell owner, factor_vm *vm);
 	void compute_position(cell offset);
 
 	void emit_relocation(cell code_template);
diff --git a/vm/layouts.hpp b/vm/layouts.hpp
index dceb9a208a..9357e927fb 100644
--- a/vm/layouts.hpp
+++ b/vm/layouts.hpp
@@ -106,9 +106,9 @@ struct header {
 	cell value;
 
         /* Default ctor to make gcc 3.x happy */
-        header() { abort(); }
+        explicit header() { abort(); }
 
-	header(cell value_) : value(value_ << TAG_BITS) {}
+	explicit header(cell value_) : value(value_ << TAG_BITS) {}
 
 	void check_header() {
 #ifdef FACTOR_DEBUG
@@ -179,7 +179,7 @@ struct byte_array : public object {
 	/* tagged */
 	cell capacity;
 
-	template<typename T> T *data() { return (T *)(this + 1); }
+	template<typename Scalar> Scalar *data() { return (Scalar *)(this + 1); }
 };
 
 /* Assembly code makes assumptions about the layout of this struct */
diff --git a/vm/local_roots.hpp b/vm/local_roots.hpp
index 22c95ed4dd..7becc906a0 100644
--- a/vm/local_roots.hpp
+++ b/vm/local_roots.hpp
@@ -1,18 +1,18 @@
 namespace factor
 {
 
-template <typename TYPE>
-struct gc_root : public tagged<TYPE>
+template<typename Type>
+struct gc_root : public tagged<Type>
 {
 	factor_vm *parent_vm;
 
-	void push() { parent_vm->check_tagged_pointer(tagged<TYPE>::value()); parent_vm->gc_locals.push_back((cell)this); }
+	void push() { parent_vm->check_tagged_pointer(tagged<Type>::value()); parent_vm->gc_locals.push_back((cell)this); }
 	
-	explicit gc_root(cell value_,factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); }
-	explicit gc_root(TYPE *value_, factor_vm *vm) : tagged<TYPE>(value_),parent_vm(vm) { push(); }
+	explicit gc_root(cell value_,factor_vm *vm) : tagged<Type>(value_),parent_vm(vm) { push(); }
+	explicit gc_root(Type *value_, factor_vm *vm) : tagged<Type>(value_),parent_vm(vm) { push(); }
 
-	const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
-	const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
+	const gc_root<Type>& operator=(const Type *x) { tagged<Type>::operator=(x); return *this; }
+	const gc_root<Type>& operator=(const cell &x) { tagged<Type>::operator=(x); return *this; }
 
 	~gc_root() {
 #ifdef FACTOR_DEBUG
diff --git a/vm/master.hpp b/vm/master.hpp
index e9b9c6cbc6..103387ad4b 100755
--- a/vm/master.hpp
+++ b/vm/master.hpp
@@ -25,23 +25,32 @@
 
 /* C++ headers */
 #include <vector>
+#include <set>
 
 #if __GNUC__ == 4
         #include <tr1/unordered_map>
 
-namespace factor {
-    using std::tr1::unordered_map;
-}
+	namespace factor
+	{
+		using std::tr1::unordered_map;
+	}
 #elif __GNUC__ == 3
         #include <boost/unordered_map.hpp>
 
-namespace factor {
-    using boost::unordered_map;
-}
+	namespace factor
+	{
+		using boost::unordered_map;
+	}
 #else
         #error Factor requires GCC 3.x or later
 #endif
 
+/* Forward-declare this since it comes up in function prototypes */
+namespace factor
+{
+	struct factor_vm;
+}
+
 /* Factor headers */
 #include "layouts.hpp"
 #include "platform.hpp"
diff --git a/vm/os-linux-ppc.hpp b/vm/os-linux-ppc.hpp
index c0d13e6f17..62671e5ded 100644
--- a/vm/os-linux-ppc.hpp
+++ b/vm/os-linux-ppc.hpp
@@ -3,7 +3,7 @@
 namespace factor
 {
 
-#define FRAME_RETURN_ADDRESS(frame) *((void **)(frame_successor(frame) + 1) + 1)
+#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1)
 
 inline static void *ucontext_stack_pointer(void *uap)
 {
diff --git a/vm/os-macosx-ppc.hpp b/vm/os-macosx-ppc.hpp
index cd2097a3fd..2bea926890 100644
--- a/vm/os-macosx-ppc.hpp
+++ b/vm/os-macosx-ppc.hpp
@@ -13,7 +13,7 @@ Used under BSD license with permission from Paolo Bonzini and Bruno Haible,
 http://sourceforge.net/mailarchive/message.php?msg_name=200503102200.32002.bruno%40clisp.org
 
 Modified for Factor by Slava Pestov */
-#define FRAME_RETURN_ADDRESS(frame) *((void **)(frame_successor(frame) + 1) + 2)
+#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 2)
 
 #define MACH_EXC_STATE_TYPE ppc_exception_state_t
 #define MACH_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE
diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp
index dc8acc445e..7470c4ff45 100644
--- a/vm/os-unix.hpp
+++ b/vm/os-unix.hpp
@@ -55,8 +55,9 @@ s64 current_micros();
 void sleep_micros(cell usec);
 
 void init_platform_globals();
-struct factor_vm;
+
 void register_vm_with_thread(factor_vm *vm);
 factor_vm *tls_vm();
 void open_console();
+
 }
diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index 1b12b47c40..5b55ce1f2b 100755
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -32,7 +32,6 @@ THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
 inline static THREADHANDLE thread_id() { return GetCurrentThread(); }
 
 void init_platform_globals();
-struct factor_vm;
 void register_vm_with_thread(factor_vm *vm);
 factor_vm *tls_vm();
 
diff --git a/vm/profiler.cpp b/vm/profiler.cpp
index eaa1dbbf27..e61c10f293 100755
--- a/vm/profiler.cpp
+++ b/vm/profiler.cpp
@@ -44,7 +44,8 @@ void factor_vm::set_profiling(bool profiling)
 	}
 
 	/* Update XTs in code heap */
-	iterate_code_heap(&factor_vm::relocate_code_block);
+	word_updater updater(this);
+	iterate_code_heap(updater);
 }
 
 void factor_vm::primitive_profiling()
diff --git a/vm/quotations.cpp b/vm/quotations.cpp
index 4cef00e117..c1ab60b43d 100755
--- a/vm/quotations.cpp
+++ b/vm/quotations.cpp
@@ -330,7 +330,9 @@ void factor_vm::compile_all_words()
 
 	}
 
-	iterate_code_heap(&factor_vm::relocate_code_block);
+	/* Update XTs in code heap */
+	word_updater updater(this);
+	iterate_code_heap(updater);
 }
 
 /* Allocates memory */
diff --git a/vm/quotations.hpp b/vm/quotations.hpp
index df079b3c47..10d2a96f66 100755
--- a/vm/quotations.hpp
+++ b/vm/quotations.hpp
@@ -5,7 +5,7 @@ struct quotation_jit : public jit {
 	gc_root<array> elements;
 	bool compiling, relocate;
 
-	quotation_jit(cell quot, bool compiling_, bool relocate_, factor_vm *vm)
+	explicit quotation_jit(cell quot, bool compiling_, bool relocate_, factor_vm *vm)
 		: jit(QUOTATION_TYPE,quot,vm),
 		  elements(owner.as<quotation>().untagged()->array,vm),
 		  compiling(compiling_),
diff --git a/vm/run.cpp b/vm/run.cpp
index 59020b85e8..1a24d1d910 100755
--- a/vm/run.cpp
+++ b/vm/run.cpp
@@ -58,7 +58,7 @@ cell factor_vm::clone_object(cell obj_)
 	else
 	{
 		cell size = object_size(obj.value());
-		object *new_obj = allot_object(obj.type(),size);
+		object *new_obj = allot_object(header(obj.type()),size);
 		memcpy(new_obj,obj.untagged(),size);
 		return tag_dynamic(new_obj);
 	}
diff --git a/vm/segments.hpp b/vm/segments.hpp
index 1884526ad2..6b2e6c69d4 100644
--- a/vm/segments.hpp
+++ b/vm/segments.hpp
@@ -1,8 +1,6 @@
 namespace factor
 {
 
-struct factor_vm;
-
 inline cell align_page(cell a)
 {
 	return align(a,getpagesize());
@@ -16,7 +14,7 @@ struct segment {
 	cell size;
 	cell end;
 
-	segment(factor_vm *myvm, cell size);
+	explicit segment(factor_vm *myvm, cell size);
 	~segment();
 };
 
diff --git a/vm/tagged.hpp b/vm/tagged.hpp
index 5f3075699a..66cfa27c17 100755
--- a/vm/tagged.hpp
+++ b/vm/tagged.hpp
@@ -1,9 +1,9 @@
 namespace factor
 {
 
-template <typename TYPE> cell tag(TYPE *value)
+template<typename Type> cell tag(Type *value)
 {
-	return RETAG(value,tag_for(TYPE::type_number));
+	return RETAG(value,tag_for(Type::type_number));
 }
 
 inline static cell tag_dynamic(object *value)
@@ -11,13 +11,13 @@ inline static cell tag_dynamic(object *value)
 	return RETAG(value,tag_for(value->h.hi_tag()));
 }
 
-template <typename TYPE>
+template<typename Type>
 struct tagged
 {
 	cell value_;
 
 	cell value() const { return value_; }
-	TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
+	Type *untagged() const { return (Type *)(UNTAG(value_)); }
 
 	cell type() const {
 		cell tag = TAG(value_);
@@ -29,9 +29,9 @@ struct tagged
 
 	bool type_p(cell type_) const { return type() == type_; }
 
-	TYPE *untag_check(factor_vm *myvm) const {
-		if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
-			myvm->type_error(TYPE::type_number,value_);
+	Type *untag_check(factor_vm *myvm) const {
+		if(Type::type_number != TYPE_COUNT && !type_p(Type::type_number))
+			myvm->type_error(Type::type_number,value_);
 		return untagged();
 	}
 
@@ -41,32 +41,32 @@ struct tagged
 #endif
 	}
 
-	explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
+	explicit tagged(Type *untagged) : value_(factor::tag(untagged)) {
 #ifdef FACTOR_DEBUG
 		untag_check(SIGNAL_VM_PTR()); 
 #endif
 	}
 
-	TYPE *operator->() const { return untagged(); }
+	Type *operator->() const { return untagged(); }
 	cell *operator&() const { return &value_; }
 
-	const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
-	const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
+	const tagged<Type> &operator=(const Type *x) { value_ = tag(x); return *this; }
+	const tagged<Type> &operator=(const cell &x) { value_ = x; return *this; }
 
-	bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
-	bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
+	bool operator==(const tagged<Type> &x) { return value_ == x.value_; }
+	bool operator!=(const tagged<Type> &x) { return value_ != x.value_; }
 
-	template<typename X> tagged<X> as() { return tagged<X>(value_); }
+	template<typename NewType> tagged<NewType> as() { return tagged<NewType>(value_); }
 };
 
-template <typename TYPE> TYPE *factor_vm::untag_check(cell value)
+template<typename Type> Type *factor_vm::untag_check(cell value)
 {
-	return tagged<TYPE>(value).untag_check(this);
+	return tagged<Type>(value).untag_check(this);
 }
 
-template <typename TYPE> TYPE *factor_vm::untag(cell value)
+template<typename Type> Type *factor_vm::untag(cell value)
 {
-	return tagged<TYPE>(value).untagged();
+	return tagged<Type>(value).untagged();
 }
 
 }
diff --git a/vm/vm.hpp b/vm/vm.hpp
index 8f2b96944f..2cbc608f2f 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -32,7 +32,8 @@ struct factor_vm
 	void primitive_check_datastack();
 
 	// run
-	cell T;  /* Canonical T object. It's just a word */
+	/* Canonical T object. It's just a word */
+	cell T;
 
 	void primitive_getenv();
 	void primitive_setenv();
@@ -168,7 +169,7 @@ struct factor_vm
 	cell next_object();
 	void primitive_next_object();
 	void primitive_end_scan();
-	template<typename T> void each_object(T &functor);
+	template<typename Iterator> void each_object(Iterator &iterator);
 	cell find_all_words();
 	cell object_size(cell tagged);
 	
@@ -228,53 +229,46 @@ struct factor_vm
 
 	// data_gc
 	/* used during garbage collection only */
-	zone *newspace;
-	bool performing_gc;
-	bool performing_compaction;
-	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;
-	/* in case a generation fills up in the middle of a gc, we jump back
-	   up to try collecting the next generation. */
-	jmp_buf gc_jmp;
+	gc_state *current_gc;
+	/* statistics */
 	gc_stats stats[max_gen_count];
 	u64 cards_scanned;
 	u64 decks_scanned;
 	u64 card_scan_time;
 	cell code_heap_scans;
-	/* What generation was being collected when copy_code_heap_roots() was last
+	/* What generation was being collected when trace_code_heap_roots() was last
 	   called? Until the next call to add_code_block(), future
 	   collections of younger generations don't have to touch the code
 	   heap. */
 	cell last_code_heap_scan;
-	/* sometimes we grow the heap */
-	bool growing_data_heap;
-	data_heap *old_data_heap;
 
 	void init_data_gc();
 	object *copy_untagged_object_impl(object *pointer, cell size);
 	object *copy_object_impl(object *untagged);
 	bool should_copy_p(object *untagged);
 	object *resolve_forwarding(object *untagged);
-	template <typename T> T *copy_untagged_object(T *untagged);
+	template<typename Type> Type *copy_untagged_object(Type *untagged);
 	cell copy_object(cell pointer);
-	void copy_handle(cell *handle);
-	void copy_card(card *ptr, cell gen, cell here);
-	void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask);
-	void copy_gen_cards(cell gen);
-	void copy_cards();
-	void copy_stack_elements(segment *region, cell top);
-	void copy_registered_locals();
-	void copy_registered_bignums();
-	void copy_roots();
+	void trace_handle(cell *handle);
+	void trace_card(card *ptr, cell gen, cell here);
+	void trace_card_deck(card_deck *deck, cell gen, card mask, card unmask);
+	void trace_generation_cards(cell gen);
+	void trace_cards();
+	void trace_stack_elements(segment *region, cell top);
+	void trace_registered_locals();
+	void trace_registered_bignums();
+	void trace_roots();
+	void trace_contexts();
+	void update_code_heap_roots();
 	cell copy_next_from_nursery(cell scan);
 	cell copy_next_from_aging(cell scan);
 	cell copy_next_from_tenured(cell scan);
 	void copy_reachable_objects(cell scan, cell *end);
+	void free_unmarked_code_blocks();
+	void update_dirty_code_blocks();
 	void begin_gc(cell requested_bytes);
-	void end_gc(cell gc_elapsed);
-	void garbage_collection(cell gen,bool growing_data_heap_,cell requested_bytes);
+	void end_gc();
+	void garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts, cell requested_bytes);
 	void gc();
 	void primitive_gc();
 	void primitive_gc_stats();
@@ -285,23 +279,15 @@ struct factor_vm
 	object *allot_object(header header, cell size);
 	void primitive_clear_gc_stats();
 
-	template<typename TYPE> TYPE *allot(cell size)
+	template<typename Type> Type *allot(cell size)
 	{
-		return (TYPE *)allot_object(header(TYPE::type_number),size);
-	}
-
-	inline bool collecting_accumulation_gen_p()
-	{
-		return ((data->have_aging_p()
-			 && collecting_gen == data->aging()
-			 && !collecting_aging_again)
-			|| collecting_gen == data->tenured());
+		return (Type *)allot_object(header(Type::type_number),size);
 	}
 
 	inline void check_data_pointer(object *pointer)
 	{
 	#ifdef FACTOR_DEBUG
-		if(!growing_data_heap)
+		if(!(current_gc && current_gc->growing_data_heap))
 		{
 			assert((cell)pointer >= data->seg->start
 			       && (cell)pointer < data->seg->end);
@@ -329,15 +315,13 @@ struct factor_vm
 	std::vector<cell> gc_bignums;
 
 	// generic arrays
-	template <typename T> T *allot_array_internal(cell capacity);
-	template <typename T> bool reallot_array_in_place_p(T *array, cell capacity);
-	template <typename TYPE> TYPE *reallot_array(TYPE *array_, cell capacity);
+	template<typename Array> Array *allot_array_internal(cell capacity);
+	template<typename Array> bool reallot_array_in_place_p(Array *array, cell capacity);
+	template<typename Array> Array *reallot_array(Array *array_, cell capacity);
 
 	//debug
 	bool fep_disabled;
 	bool full_output;
-	cell look_for;
-	cell obj;
 
 	void print_chars(string* str);
 	void print_word(word* word, cell nesting);
@@ -349,7 +333,6 @@ struct factor_vm
 	void print_objects(cell *start, cell *end);
 	void print_datastack();
 	void print_retainstack();
-	void print_stack_frame(stack_frame *frame);
 	void print_callstack();
 	void dump_cell(cell x);
 	void dump_memory(cell from, cell to);
@@ -499,8 +482,8 @@ struct factor_vm
 	inline double untag_float_check(cell tagged);
 	inline fixnum float_to_fixnum(cell tagged);
 	inline double fixnum_to_float(cell tagged);
-	template <typename T> T *untag_check(cell value);
-	template <typename T> T *untag(cell value);
+	template<typename Type> Type *untag_check(cell value);
+	template<typename Type> Type *untag(cell value);
 	
 	//io
 	void init_c_io();
@@ -515,8 +498,6 @@ struct factor_vm
 	void primitive_fclose();
 
 	//code_block
-	typedef void (factor_vm::*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled);
-
 	relocation_type relocation_type_of(relocation_entry r);
 	relocation_class relocation_class_of(relocation_entry r);
 	cell relocation_offset_of(relocation_entry r);
@@ -529,20 +510,16 @@ struct factor_vm
 	void undefined_symbol();
 	void *get_rel_symbol(array *literals, cell index);
 	cell compute_relocation(relocation_entry rel, cell index, code_block *compiled);
-	void iterate_relocations(code_block *compiled, relocation_iterator iter);
+	template<typename Iterator> void iterate_relocations(code_block *compiled, Iterator &iter);
 	void store_address_2_2(cell *ptr, cell value);
 	void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift);
 	void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
-	void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled);
 	void update_literal_references(code_block *compiled);
-	void copy_literal_references(code_block *compiled);
+	void trace_literal_references(code_block *compiled);
 	void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled);
-	void update_word_references_step(relocation_entry rel, cell index, code_block *compiled);
 	void update_word_references(code_block *compiled);
-	void update_literal_and_word_references(code_block *compiled);
 	void check_code_address(cell address);
 	void mark_code_block(code_block *compiled);
-	void mark_stack_frame_step(stack_frame *frame);
 	void mark_active_blocks(context *stacks);
 	void mark_object_code_block(object *object);
 	void relocate_code_block(code_block *compiled);
@@ -562,18 +539,29 @@ struct factor_vm
 	void init_code_heap(cell size);
 	bool in_code_heap_p(cell ptr);
 	void jit_compile_word(cell word_, cell def_, bool relocate);
-	void iterate_code_heap(code_heap_iterator iter);
-	void copy_code_heap_roots();
+	void trace_code_heap_roots();
 	void update_code_heap_words();
 	void primitive_modify_code_heap();
 	void primitive_code_room();
 	code_block *forward_xt(code_block *compiled);
-	void forward_frame_xt(stack_frame *frame);
 	void forward_object_xts();
 	void fixup_object_xts();
 	void compact_code_heap();
 	inline void check_code_pointer(cell ptr);
 
+	/* Apply a function to every code block */
+	template<typename Iterator> void factor_vm::iterate_code_heap(Iterator &iter)
+	{
+		heap_block *scan = code->first_block();
+	
+		while(scan)
+		{
+			if(scan->status != B_FREE)
+				iter((code_block *)scan);
+			scan = code->next_block(scan);
+		}
+	}
+
 	//image
 	cell code_relocation_base;
 	cell data_relocation_base;
@@ -585,11 +573,10 @@ struct factor_vm
 	void primitive_save_image();
 	void primitive_save_image_and_exit();
 	void data_fixup(cell *cell);
-	template <typename T> void code_fixup(T **handle);
+	template<typename Type> void code_fixup(Type **handle);
 	void fixup_word(word *word);
 	void fixup_quotation(quotation *quot);
 	void fixup_alien(alien *d);
-	void fixup_stack_frame(stack_frame *frame);
 	void fixup_callstack_object(callstack *stack);
 	void relocate_object(object *object);
 	void relocate_data();
@@ -598,7 +585,7 @@ struct factor_vm
 	void load_image(vm_parameters *p);
 
 	//callstack
-	template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator);
+	template<typename Iterator> void iterate_callstack_object(callstack *stack_, Iterator &iterator);
 	void check_frame(stack_frame *frame);
 	callstack *allot_callstack(cell size);
 	stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
@@ -617,8 +604,25 @@ struct factor_vm
 	void primitive_innermost_stack_frame_scan();
 	void primitive_set_innermost_stack_frame_quot();
 	void save_callstack_bottom(stack_frame *callstack_bottom);
-	template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator);
-	inline void do_slots(cell obj, void (* iter)(cell *,factor_vm*));
+	template<typename Iterator> void iterate_callstack(cell top, cell bottom, Iterator &iterator);
+	
+	/* Every object has a regular representation in the runtime, which makes GC
+	much simpler. Every slot of the object until binary_payload_start is a pointer
+	to some other object. */
+	template<typename Iterator> void do_slots(cell obj, Iterator &iter)
+	{
+		cell scan = obj;
+		cell payload_start = binary_payload_start((object *)obj);
+		cell end = obj + payload_start;
+	
+		scan += sizeof(cell);
+	
+		while(scan < end)
+		{
+			iter((cell *)scan);
+			scan += sizeof(cell);
+		}
+	}
 
 	//alien
 	char *pinned_alien_offset(cell obj);
@@ -742,10 +746,6 @@ struct factor_vm
 		: profiling_p(false),
 		  secure_gc(false),
 		  gc_off(false),
-		  performing_gc(false),
-		  performing_compaction(false),
-		  collecting_aging_again(false),
-		  growing_data_heap(false),
 		  fep_disabled(false),
 		  full_output(false),
 		  max_pic_size(0)
@@ -796,6 +796,6 @@ struct factor_vm
   #define SIGNAL_VM_PTR() tls_vm()
 #endif
 
-extern unordered_map<THREADHANDLE, factor_vm*> thread_vms;
+extern unordered_map<THREADHANDLE, factor_vm *> thread_vms;
 
 }

From 24ba367ca04702c1877499bf1f91b236df282c96 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Sat, 3 Oct 2009 09:47:06 -0500
Subject: [PATCH 6/6] vm.hpp: fix typo

---
 vm/vm.hpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 2cbc608f2f..ff96467179 100644
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -550,7 +550,7 @@ struct factor_vm
 	inline void check_code_pointer(cell ptr);
 
 	/* Apply a function to every code block */
-	template<typename Iterator> void factor_vm::iterate_code_heap(Iterator &iter)
+	template<typename Iterator> void iterate_code_heap(Iterator &iter)
 	{
 		heap_block *scan = code->first_block();