compiler.cfg.intrinsics.fixnum: more docs and tests

basis/compiler/cfg/intrinsics/fixnum/fixnum-docs.factor

@@ -1,4 +1,5 @@
-USING: compiler.cfg.instructions help.markup help.syntax layouts math ;
+USING: compiler.cfg compiler.cfg.instructions help.markup help.syntax
+layouts math quotations words ;
 IN: compiler.cfg.intrinsics.fixnum
 
 HELP: fixnum*overflow
@@ -9,3 +10,27 @@ HELP: fixnum*overflow
 HELP: emit-fixnum-comparison
 { $values { "cc" "comparison symbol" } }
 { $description "Emits a " { $link ##compare-integer } " instruction to the make sequence." } ;
+
+HELP: emit-fixnum-overflow-op
+{ $values
+  { "block" basic-block }
+  { "quot" quotation }
+  { "word" word }
+  { "block'" basic-block }
+}
+{ $description "Inputs to the final instruction need to be copied because of loc>vreg sync." } ;
+
+HELP: emit-fixnum-shift-general
+{ $values
+  { "block" basic-block }
+  { "block'" basic-block }
+}
+{ $description "Emits intrinsic code for shifting a " { $link fixnum } ". For positive shifts, " { $link ##shl } " is used, for negative shifts it is more complicated." } ;
+
+ARTICLE: "compiler.cfg.intrinsics.fixnum" "Generating instructions for fixnum arithmetic"
+"Combinators:"
+{ $subsections
+  emit-fixnum-overflow-op
+} ;
+
+ABOUT: "compiler.cfg.intrinsics.fixnum"

basis/compiler/cfg/intrinsics/fixnum/fixnum-tests.factor

@@ -1,5 +1,8 @@
-USING: compiler.cfg.comparisons compiler.cfg.instructions
+USING: accessors compiler.cfg compiler.cfg.builder.blocks
-compiler.cfg.intrinsics.fixnum compiler.test make tools.test ;
+compiler.cfg.comparisons compiler.cfg.instructions
+compiler.cfg.intrinsics.fixnum compiler.cfg.registers
+compiler.cfg.utilities compiler.test cpu.architecture kernel make
+namespaces sequences ;
 IN: compiler.cfg.intrinsics.fixnum.tests
 
 {
@@ -15,3 +18,43 @@ IN: compiler.cfg.intrinsics.fixnum.tests
 } [
     [ cc> emit-fixnum-comparison ] V{ } make
 ] cfg-unit-test
+
+{
+    V{
+        T{ ##compare-integer-imm-branch
+           { src1 1 }
+           { src2 0 }
+           { cc cc> }
+        }
+    }
+    108
+} [
+    V{ } 108 insns>block dup set-basic-block
+    emit-fixnum-shift-general
+    predecessors>> first predecessors>> first
+    [ instructions>> ] [ number>> ] bi
+] cfg-unit-test
+
+{
+    V{
+        T{ ##copy
+           { dst 1 }
+           { src 321 }
+           { rep any-rep }
+        }
+        T{ ##inc { loc D: -1 } }
+        T{ ##branch }
+    }
+    77
+} [
+    321 V{ } 77 insns>block emit-no-overflow-case
+    first [ instructions>> ] [ predecessors>> first number>> ] bi
+] cfg-unit-test
+
+{
+    V{ T{ ##call { word 2drop } } T{ ##branch } }
+    107
+} [
+    \ 2drop V{ } 107 insns>block emit-overflow-case
+    first [ instructions>> ] [ predecessors>> first number>> ] bi
+] cfg-unit-test