compiler.cfg.save-contexts: refactoring of the vocab, using the simple-optimization combinator and union classes you can shorten it a lot

basis/compiler/cfg/save-contexts/save-contexts-docs.factor

@@ -1,17 +1,25 @@
-USING: compiler.cfg compiler.cfg.instructions help.markup help.syntax ;
+USING: compiler.cfg compiler.cfg.instructions help.markup help.syntax
+math sequences ;
 IN: compiler.cfg.save-contexts
 
 HELP: insert-save-contexts
 { $values { "cfg" cfg } }
 { $description "Inserts " { $link ##save-context } " instructions in each " { $link basic-block } " in the cfg that needs them. Save contexts are needed after instructions that modify the context, or instructions that read parameter registers." }
-{ $see-also needs-save-context? } ;
+{ $see-also context-save-needed } ;
 
-HELP: bb-needs-save-context?
+HELP: insns-needs-save-context?
-{ $values { "bb" basic-block } { "?" "a boolean" } }
+{ $values { "insns" sequence } { "?" "a boolean" } }
-{ $description "Whether to insert a " { $link ##save-context } " instruction in the block or not." }
+{ $description "Whether to insert a " { $link ##save-context } " instruction in the given instruction sequence or not." }
-{ $see-also needs-save-context? } ;
+{ $see-also context-save-needed } ;
 
-HELP: needs-save-context?
+HELP: context-save-needed
-{ $values { "insn" "an instruction" } { "?" "a boolean" } }
+{ $class-description "Union class of all instructions that needs to be preceeded by a " { $link ##save-context } " instruction. Only instructions that can allocate memory mandates save contexts." } ;
-{ $description "Whether the given instruction needs to be preceeded by a " { $link ##save-context } " instruction or not. Only instructions that can allocate memory mandates save contexts." }
+
-{ $see-also gc-map-insn } ;
+HELP: save-context-offset
+{ $values { "insns" sequence } { "n" integer } }
+{ $description { $link "##save-context" } " must be placed after instructions that modify the context, or instructions that read parameter registers." } ;
+
+ARTICLE: "compiler.cfg.save-contexts" "Insert context saves"
+"Inserts " { $link ##save-context } " in blocks that need them." ;
+
+ABOUT: "compiler.cfg.save-contexts"

basis/compiler/cfg/save-contexts/save-contexts-tests.factor

@@ -11,7 +11,7 @@ V{
     T{ ##branch }
 } 0 test-bb
 
-0 get insert-save-context
+0 get [ insert-save-context ] change-instructions drop
 
 [
     V{
@@ -31,7 +31,7 @@ V{
     }
 } 0 test-bb
 
-0 get insert-save-context
+0 get [ insert-save-context ] change-instructions drop
 
 [
     V{
@@ -50,7 +50,7 @@ V{
     T{ ##box }
 } 0 test-bb
 
-0 get insert-save-context
+0 get [ insert-save-context ] change-instructions drop
 
 [
     V{
@@ -61,3 +61,12 @@ V{
 ] [
     0 get instructions>>
 ] unit-test
+
+{ 3 } [
+    V{
+        T{ ##phi }
+        T{ ##phi }
+        T{ ##phi }
+        T{ insn }
+    } save-context-offset
+] unit-test

basis/compiler/cfg/save-contexts/save-contexts.factor

@@ -1,47 +1,28 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.short-circuit
+USING: compiler.cfg.instructions compiler.cfg.registers compiler.cfg.rpo
-compiler.cfg.instructions compiler.cfg.registers
+cpu.architecture kernel sequences ;
-compiler.cfg.rpo cpu.architecture kernel sequences ;
 IN: compiler.cfg.save-contexts
 
-! Insert context saves.
+UNION: context-modifier ##phi ##inc-d ##inc-r ##callback-inputs ;
+UNION: context-save-needed gc-map-insn ;
 
-GENERIC: needs-save-context? ( insn -- ? )
+: save-context-offset ( insns -- n )
+    [ context-modifier? not ] find drop ;
 
-M: gc-map-insn needs-save-context? drop t ;
+: insns-needs-save-context? ( insns -- ? )
-M: insn needs-save-context? drop f ;
+    [ context-save-needed? ] any? ;
 
-: bb-needs-save-context? ( bb -- ? )
+: insert-save-context ( insns -- insns' )
-    {
+    dup insns-needs-save-context? [
-        [ kill-block?>> not ]
-        [ instructions>> [ needs-save-context? ] any? ]
-    } 1&& ;
-
-GENERIC: modifies-context? ( insn -- ? )
-
-M: ##phi modifies-context? drop t ;
-M: ##inc-d modifies-context? drop t ;
-M: ##inc-r modifies-context? drop t ;
-M: ##callback-inputs modifies-context? drop t ;
-M: insn modifies-context? drop f ;
-
-: save-context-offset ( bb -- n )
-    ! ##save-context must be placed after instructions that
-    ! modify the context, or instructions that read parameter
-    ! registers.
-    instructions>> [ modifies-context? not ] find drop ;
-
-: insert-save-context ( bb -- )
-    dup bb-needs-save-context? [
         [
             int-rep next-vreg-rep
             int-rep next-vreg-rep
             ##save-context new-insn
         ] dip
         [ save-context-offset ] keep
-        [ insert-nth ] change-instructions drop
+        insert-nth
-    ] [ drop ] if ;
+    ] when ;
 
 : insert-save-contexts ( cfg -- )
-    [ insert-save-context ] each-basic-block ;
+    [ insert-save-context ] simple-optimization ;