diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor new file mode 100644 index 0000000000..313fd65dac --- /dev/null +++ b/basis/compiler/tests/low-level-ir.factor @@ -0,0 +1,133 @@ +USING: accessors assocs compiler compiler.cfg +compiler.cfg.debugger compiler.cfg.instructions compiler.cfg.mr +compiler.cfg.registers compiler.codegen compiler.units +cpu.architecture hashtables kernel namespaces sequences +tools.test vectors words layouts literals math arrays +alien.syntax ; +IN: compiler.tests + +: compile-cfg ( cfg -- word ) + gensym + [ build-mr generate code>> ] dip + [ associate >alist modify-code-heap ] keep ; + +: compile-test-cfg ( -- word ) + cfg new + 0 get >>entry + compile-cfg ; + +: compile-test-bb ( insns -- result ) + V{ T{ ##prologue } T{ ##branch } } 0 test-bb + V{ + T{ ##inc-d f 1 } + T{ ##replace f V int-regs 0 D 0 } + T{ ##branch } + } append 1 test-bb + V{ + T{ ##epilogue } + T{ ##return } + } 2 test-bb + 0 get 1 get 1vector >>successors drop + 1 get 2 get 1vector >>successors drop + compile-test-cfg + execute( -- result ) ; + +! loading immediates +[ f ] [ + V{ + T{ ##load-immediate f V int-regs 0 5 } + } compile-test-bb +] unit-test + +[ "hello" ] [ + V{ + T{ ##load-reference f V int-regs 0 "hello" } + } compile-test-bb +] unit-test + +! make sure slot access works when the destination is +! one of the sources +[ t ] [ + V{ + T{ ##load-immediate f V int-regs 1 $[ 2 cell log2 shift ] } + T{ ##load-reference f V int-regs 0 { t f t } } + T{ ##slot f V int-regs 0 V int-regs 0 V int-regs 1 $[ array tag-number ] V int-regs 2 } + } compile-test-bb +] unit-test + +[ t ] [ + V{ + T{ ##load-reference f V int-regs 0 { t f t } } + T{ ##slot-imm f V int-regs 0 V int-regs 0 2 $[ array tag-number ] V int-regs 2 } + } compile-test-bb +] unit-test + +[ t ] [ + V{ + T{ ##load-immediate f V int-regs 1 $[ 2 cell log2 shift ] } + T{ ##load-reference f V int-regs 0 { t f t } } + T{ ##set-slot f V int-regs 0 V int-regs 0 V int-regs 1 $[ array tag-number ] V int-regs 2 } + } compile-test-bb + dup first eq? +] unit-test + +[ t ] [ + V{ + T{ ##load-reference f V int-regs 0 { t f t } } + T{ ##set-slot-imm f V int-regs 0 V int-regs 0 2 $[ array tag-number ] } + } compile-test-bb + dup first eq? +] unit-test + +[ 8 ] [ + V{ + T{ ##load-immediate f V int-regs 0 4 } + T{ ##shl f V int-regs 0 V int-regs 0 V int-regs 0 } + } compile-test-bb +] unit-test + +[ 4 ] [ + V{ + T{ ##load-immediate f V int-regs 0 4 } + T{ ##shl-imm f V int-regs 0 V int-regs 0 3 } + } compile-test-bb +] unit-test + +[ 31 ] [ + V{ + T{ ##load-reference f V int-regs 1 B{ 31 67 52 } } + T{ ##unbox-any-c-ptr f V int-regs 0 V int-regs 1 V int-regs 2 } + T{ ##alien-unsigned-1 f V int-regs 0 V int-regs 0 } + T{ ##shl-imm f V int-regs 0 V int-regs 0 3 } + } compile-test-bb +] unit-test + +[ CHAR: l ] [ + V{ + T{ ##load-reference f V int-regs 0 "hello world" } + T{ ##load-immediate f V int-regs 1 3 } + T{ ##string-nth f V int-regs 0 V int-regs 0 V int-regs 1 V int-regs 2 } + T{ ##shl-imm f V int-regs 0 V int-regs 0 3 } + } compile-test-bb +] unit-test + +! These are def-is-use-insns +USE: multiline + +/* + +[ 100 ] [ + V{ + T{ ##load-immediate f V int-regs 0 100 } + T{ ##integer>bignum f V int-regs 0 V int-regs 0 V int-regs 1 } + } compile-test-bb +] unit-test + +[ 1 ] [ + V{ + T{ ##load-reference f V int-regs 0 ALIEN: 8 } + T{ ##unbox-any-c-ptr f V int-regs 0 V int-regs 0 V int-regs 1 } + } compile-test-bb +] unit-test + +*/ \ No newline at end of file