compiler.cfg.save-contexts: add new pass

diff --git a/basis/compiler/cfg/save-contexts/authors.txt b/basis/compiler/cfg/save-contexts/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /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 (file)
index 0000000..85c71dd
--- /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 (file)
index 0000000..fd92ace
--- /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 ;