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 ;