diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index bd3cd9f2a4..32e5d46c61 100644
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -533,6 +533,10 @@ INSN: ##gc
 temp: temp1/int-rep temp2/int-rep
 literal: data-values tagged-values uninitialized-locs ;
 
+INSN: ##save-context
+temp: temp1/int-rep temp2/int-rep
+literal: callback-allowed? ;
+
 ! Instructions used by machine IR only.
 INSN: _prologue
 literal: stack-frame ;
diff --git a/basis/compiler/cfg/instructions/syntax/syntax.factor b/basis/compiler/cfg/instructions/syntax/syntax.factor
index cc1d0df21c..bca5e1ee64 100644
--- a/basis/compiler/cfg/instructions/syntax/syntax.factor
+++ b/basis/compiler/cfg/instructions/syntax/syntax.factor
@@ -41,11 +41,11 @@ TUPLE: insn-slot-spec type name rep ;
     "insn-slots" word-prop
     [ type>> def eq? ] find nip ;
 
-: insn-use-slots ( class -- slot/f )
+: insn-use-slots ( class -- slots )
     "insn-slots" word-prop
     [ type>> use eq? ] filter ;
 
-: insn-temp-slots ( class -- slot/f )
+: insn-temp-slots ( class -- slots )
     "insn-slots" word-prop
     [ type>> temp eq? ] filter ;
 
diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index 649032b469..35e0c6e3aa 100644
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/basis/compiler/cfg/optimizer/optimizer.factor
@@ -13,6 +13,7 @@ compiler.cfg.dce
 compiler.cfg.write-barrier
 compiler.cfg.representations
 compiler.cfg.two-operand
+compiler.cfg.save-contexts
 compiler.cfg.ssa.destruction
 compiler.cfg.empty-blocks
 compiler.cfg.checker ;
@@ -38,6 +39,7 @@ SYMBOL: check-optimizer?
     eliminate-write-barriers
     select-representations
     convert-two-operand
+    insert-save-contexts
     destruct-ssa
     delete-empty-blocks
     ?check ;
diff --git a/basis/compiler/cfg/save-contexts/authors.txt b/basis/compiler/cfg/save-contexts/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/basis/compiler/cfg/save-contexts/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/compiler/cfg/save-contexts/save-contexts-tests.factor b/basis/compiler/cfg/save-contexts/save-contexts-tests.factor
new file mode 100644
index 0000000000..85c71ddbc8
--- /dev/null
+++ b/basis/compiler/cfg/save-contexts/save-contexts-tests.factor
@@ -0,0 +1,37 @@
+USING: accessors compiler.cfg.debugger
+compiler.cfg.instructions compiler.cfg.save-contexts namespaces
+tools.test ;
+IN: compiler.cfg.save-contexts.tests
+
+V{
+    T{ ##save-context f 0 1 f }
+    T{ ##save-context f 0 1 t }
+    T{ ##branch }
+} 0 test-bb
+
+0 get combine-in-block
+
+[
+    V{
+        T{ ##save-context f 0 1 t }
+        T{ ##branch }
+    }
+] [
+    0 get instructions>>
+] unit-test
+
+V{
+    T{ ##add f 1 2 3 }
+    T{ ##branch }
+} 0 test-bb
+
+0 get combine-in-block
+
+[
+    V{
+        T{ ##add f 1 2 3 }
+        T{ ##branch }
+    }
+] [
+    0 get instructions>>
+] unit-test
diff --git a/basis/compiler/cfg/save-contexts/save-contexts.factor b/basis/compiler/cfg/save-contexts/save-contexts.factor
new file mode 100644
index 0000000000..fd92ace150
--- /dev/null
+++ b/basis/compiler/cfg/save-contexts/save-contexts.factor
@@ -0,0 +1,38 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.rpo cpu.architecture kernel sequences vectors ;
+IN: compiler.cfg.save-contexts
+
+! Insert context saves.
+
+: needs-save-context? ( insns -- ? )
+    [
+        {
+            [ ##unary-float-function? ]
+            [ ##binary-float-function? ]
+            [ ##alien-invoke? ]
+            [ ##alien-indirect? ]
+        } 1||
+    ] any? ;
+
+: needs-callback-context? ( insns -- ? )
+    [
+        {
+            [ ##alien-invoke? ]
+            [ ##alien-indirect? ]
+        } 1||
+    ] any? ;
+
+: insert-save-context ( bb -- )
+    dup instructions>> dup needs-save-context? [
+        int-rep next-vreg-rep
+        int-rep next-vreg-rep
+        pick needs-callback-context?
+        \ ##save-context new-insn prefix
+        >>instructions drop
+    ] [ 2drop ] if ;
+
+: insert-save-contexts ( cfg -- cfg' )
+    dup [ insert-save-context ] each-basic-block ;
diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor
index 23b02aa224..d441b961c5 100755
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@@ -201,6 +201,7 @@ CODEGEN: ##compare %compare
 CODEGEN: ##compare-imm %compare-imm
 CODEGEN: ##compare-float-ordered %compare-float-ordered
 CODEGEN: ##compare-float-unordered %compare-float-unordered
+CODEGEN: ##save-context %save-context
 
 CODEGEN: _fixnum-add %fixnum-add
 CODEGEN: _fixnum-sub %fixnum-sub
@@ -254,6 +255,7 @@ M: _gc generate-insn
         [ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
         [ data-values>> save-data-regs ]
         [ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ]
+        [ [ temp1>> ] [ temp2>> ] bi t %save-context ]
         [ tagged-values>> length %call-gc ]
         [ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
         [ data-values>> load-data-regs ]
@@ -396,8 +398,6 @@ M: long-long-type flatten-value-type ( type -- types )
 
 M: ##alien-invoke generate-insn
     params>>
-    ! Save registers for GC
-    %prepare-alien-invoke
     ! Unbox parameters
     dup objects>registers
     %prepare-var-args
@@ -410,8 +410,6 @@ M: ##alien-invoke generate-insn
 ! ##alien-indirect
 M: ##alien-indirect generate-insn
     params>>
-    ! Save registers for GC
-    %prepare-alien-invoke
     ! Save alien at top of stack to temporary storage
     %prepare-alien-indirect
     ! Unbox parameters
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index b6955fabf1..d6611c3384 100644
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -289,7 +289,7 @@ HOOK: %save-param-reg cpu ( stack reg rep -- )
 
 HOOK: %load-param-reg cpu ( stack reg rep -- )
 
-HOOK: %prepare-alien-invoke cpu ( -- )
+HOOK: %save-context cpu ( temp1 temp2 callback-allowed? -- )
 
 HOOK: %prepare-var-args cpu ( -- )
 
diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 8c85ef66ec..83a9443e7f 100644
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -468,7 +468,6 @@ M:: ppc %load-gc-root ( gc-root register -- )
     register 1 gc-root gc-root@ LWZ ;
 
 M:: ppc %call-gc ( gc-root-count -- )
-    %prepare-alien-invoke
     3 1 gc-root-base local@ ADDI
     gc-root-count 4 LI
     "inline_gc" f %alien-invoke ;
@@ -670,15 +669,17 @@ M: ppc %box-large-struct ( n c-type -- )
     ! Call the function
     "box_value_struct" f %alien-invoke ;
 
-M: ppc %prepare-alien-invoke
+M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    scratch-reg "stack_chain" f %alien-global
-    scratch-reg scratch-reg 0 LWZ
-    1 scratch-reg 0 STW
-    ds-reg scratch-reg 8 STW
-    rs-reg scratch-reg 12 STW ;
+    temp1 "stack_chain" f %alien-global
+    temp1 temp1 0 LWZ
+    1 temp1 0 STW
+    callback-allowed? [
+        ds-reg temp1 8 STW
+        rs-reg temp1 12 STW
+    ] when ;
 
 M: ppc %alien-invoke ( symbol dll -- )
     [ 11 ] 2dip %alien-global 11 MTLR BLRL ;
diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index 186c1c4c0c..e124bd8be3 100644
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -610,7 +610,6 @@ M:: x86 %call-gc ( gc-root-count -- )
     ! Pass number of roots as second parameter
     param-reg-2 gc-root-count MOV
     ! Call GC
-    %prepare-alien-invoke
     "inline_gc" f %alien-invoke ;
 
 M: x86 %alien-global
@@ -739,16 +738,18 @@ M:: x86 %reload ( dst rep n -- )
 
 M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
 
-M: x86 %prepare-alien-invoke
+M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
     #! Save Factor stack pointers in case the C code calls a
     #! callback which does a GC, which must reliably trace
     #! all roots.
-    temp-reg "stack_chain" f %alien-global
-    temp-reg temp-reg [] MOV
-    temp-reg [] stack-reg MOV
-    temp-reg [] cell SUB
-    temp-reg 2 cells [+] ds-reg MOV
-    temp-reg 3 cells [+] rs-reg MOV ;
+    temp1 "stack_chain" f %alien-global
+    temp1 temp1 [] MOV
+    temp2 stack-reg cell neg [+] LEA
+    temp1 [] temp2 MOV
+    callback-allowed? [
+        temp1 2 cells [+] ds-reg MOV
+        temp1 3 cells [+] rs-reg MOV
+    ] when ;
 
 M: x86 value-struct? drop t ;
 
diff --git a/basis/tools/annotations/annotations-docs.factor b/basis/tools/annotations/annotations-docs.factor
index ba6572c202..89ef6192c6 100644
--- a/basis/tools/annotations/annotations-docs.factor
+++ b/basis/tools/annotations/annotations-docs.factor
@@ -16,7 +16,10 @@ $nl
 { $subsection add-timing }
 { $subsection word-timing. }
 "All of the above words are implemented using a single combinator which applies a quotation to a word definition to yield a new definition:"
-{ $subsection annotate } ;
+{ $subsection annotate }
+{ $warning
+    "Certain internal words, such as words in the " { $vocab-link "math" } ", " { $vocab-link "sequences" } " and UI vocabularies, cannot be annotated, since the annotated code may end up recursively invoking the word in question. This may crash or hang Factor. It is safest to only define annotations on your own words."
+} ;
 
 ABOUT: "tools.annotations"