From 5c8d4bee525e3ee31285e199a3189885c33884c9 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Thu, 2 Jul 2009 10:43:51 +1200 Subject: [PATCH 01/15] Inline C --- basis/alien/c-syntax/c-syntax.factor | 69 ++++++++++++++++++++++++++++ basis/alien/compile/compile.factor | 31 +++++++++++++ 2 files changed, 100 insertions(+) create mode 100644 basis/alien/c-syntax/c-syntax.factor create mode 100644 basis/alien/compile/compile.factor diff --git a/basis/alien/c-syntax/c-syntax.factor b/basis/alien/c-syntax/c-syntax.factor new file mode 100644 index 0000000000..0ea61da301 --- /dev/null +++ b/basis/alien/c-syntax/c-syntax.factor @@ -0,0 +1,69 @@ +USING: accessors alien.compile alien.libraries alien.parser +arrays fry generalizations io.files.info io.files.temp kernel +lexer math.order multiline namespaces sequences system +vocabs.loader vocabs.parser words ; +IN: alien.c-syntax + +> ] bi@ <=> +lt+ = ; + +: compile-library ( -- ) + "library-is-c++" get [ "g++" ] [ "gcc" ] if + "c-compiler-args" get + "c-library-vector" get "\n" join + "c-library" get compile-to-library ; + +: (;C-LIBRARY) ( -- ) + compile-library? [ compile-library ] when + "c-library" get library-path "cdecl" add-library ; +PRIVATE> + +SYNTAX: C-LIBRARY: (C-LIBRARY:) ; + +SYNTAX: C++-LIBRARY: (C-LIBRARY:) t "library-is-c++" set ; + +SYNTAX: C-LINK: (C-LINK:) ; + +SYNTAX: C-FRAMEWORK: (C-FRAMEWORK:) ; + +SYNTAX: C-LINK/FRAMEWORK: + os macosx? [ (C-LINK:) ] [ (C-FRAMEWORK:) ] if ; + +SYNTAX: C-INCLUDE: + "#include " scan append "c-library-vector" get push ; + +SYNTAX: C-FUNCTION: + return-library-function-params + [ make-function define-declared ] + 4 nkeep (C-FUNCTION:) + " {\n" append parse-here append "\n}\n" append + "c-library-vector" get push ; + +SYNTAX: ;C-LIBRARY (;C-LIBRARY) ; + +SYNTAX: ;C++-LIBRARY (;C-LIBRARY) ; diff --git a/basis/alien/compile/compile.factor b/basis/alien/compile/compile.factor new file mode 100644 index 0000000000..6f1bc20545 --- /dev/null +++ b/basis/alien/compile/compile.factor @@ -0,0 +1,31 @@ +USING: accessors arrays combinators generalizations +io.encodings.ascii io.files io.files.temp io.launcher kernel +sequences system ; +IN: alien.compile + +: library-suffix ( -- str ) + os { + { [ dup macosx? ] [ drop ".dylib" ] } + { [ dup unix? ] [ drop ".so" ] } + { [ dup windows? ] [ drop ".dll" ] } + } cond ; + +: compile-to-object ( compiler contents name -- ) + [ ".src" append ] [ ".o" append ] bi [ temp-file ] bi@ + [ tuck ascii set-file-contents ] dip + swap 2array { "-fPIC" "-c" "-o" } prepend + swap prefix try-process ; + +: link-object ( compiler args name -- ) + [ "lib" prepend library-suffix append ] [ ".o" append ] bi + [ temp-file ] bi@ 2array + os { + { [ dup linux? ] + [ drop { "-shared" "-o" } ] } + { [ dup macosx? ] + [ drop { "-g" "-prebind" "-dynamiclib" "-o" } ] } + [ name>> "unimplemented for: " prepend throw ] + } cond prepend prepend swap prefix try-process ; + +: compile-to-library ( compiler args contents name -- ) + [ [ nip ] dip compile-to-object ] 4 nkeep nip link-object ; From 9e240eb3b9714d928d1c0f9acbc0f7499b3c19f0 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Thu, 2 Jul 2009 10:40:12 +1200 Subject: [PATCH 02/15] Removed C++-LIBRARY: in favour of COMPILE-AS-C++ statement --- basis/alien/c-syntax/c-syntax.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/basis/alien/c-syntax/c-syntax.factor b/basis/alien/c-syntax/c-syntax.factor index 0ea61da301..eb17c544de 100644 --- a/basis/alien/c-syntax/c-syntax.factor +++ b/basis/alien/c-syntax/c-syntax.factor @@ -45,7 +45,7 @@ PRIVATE> SYNTAX: C-LIBRARY: (C-LIBRARY:) ; -SYNTAX: C++-LIBRARY: (C-LIBRARY:) t "library-is-c++" set ; +SYNTAX: COMPILE-AS-C++ t "library-is-c++" set ; SYNTAX: C-LINK: (C-LINK:) ; @@ -65,5 +65,3 @@ SYNTAX: C-FUNCTION: "c-library-vector" get push ; SYNTAX: ;C-LIBRARY (;C-LIBRARY) ; - -SYNTAX: ;C++-LIBRARY (;C-LIBRARY) ; From 542e4909507c46e1aba26e5d051bc5265752e7c0 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 07:33:14 +1200 Subject: [PATCH 03/15] alien.c-syntax: fixed host of problems --- basis/alien/c-syntax/c-syntax.factor | 27 +++++++++++++++-------- basis/alien/compile/compile.factor | 32 +++++++++++++++++----------- 2 files changed, 38 insertions(+), 21 deletions(-) diff --git a/basis/alien/c-syntax/c-syntax.factor b/basis/alien/c-syntax/c-syntax.factor index eb17c544de..2d904c3c91 100644 --- a/basis/alien/c-syntax/c-syntax.factor +++ b/basis/alien/c-syntax/c-syntax.factor @@ -1,6 +1,6 @@ USING: accessors alien.compile alien.libraries alien.parser -arrays fry generalizations io.files.info io.files.temp kernel -lexer math.order multiline namespaces sequences system +arrays fry generalizations io.files io.files.info io.files.temp +kernel lexer math.order multiline namespaces sequences system vocabs.loader vocabs.parser words ; IN: alien.c-syntax @@ -18,10 +18,17 @@ IN: alien.c-syntax : return-library-function-params ( -- return library function params ) scan "c-library" get scan ")" parse-tokens - [ "(" subseq? not ] filter ; + [ "(" subseq? not ] filter [ + [ dup CHAR: - = [ drop CHAR: space ] when ] map + ] 3dip ; + +: factor-function ( return library functions params -- ) + [ dup "const " head? [ 6 tail ] when ] 3dip + make-function define-declared ; : (C-FUNCTION:) ( return library function params -- str ) - [ nip ] dip " " join "(" prepend ")" append 3array " " join + [ nip ] dip + " " join "(" prepend ")" append 3array " " join "library-is-c++" get [ "extern \"C\" " prepend ] when ; : library-path ( -- str ) @@ -29,11 +36,13 @@ IN: alien.c-syntax 3array concat temp-file ; : compile-library? ( -- ? ) - library-path current-vocab vocab-source-path - [ file-info modified>> ] bi@ <=> +lt+ = ; + library-path dup exists? [ + current-vocab vocab-source-path + [ file-info modified>> ] bi@ <=> +lt+ = + ] [ drop t ] if ; : compile-library ( -- ) - "library-is-c++" get [ "g++" ] [ "gcc" ] if + "library-is-c++" get [ "C++" ] [ "C" ] if "c-compiler-args" get "c-library-vector" get "\n" join "c-library" get compile-to-library ; @@ -52,14 +61,14 @@ SYNTAX: C-LINK: (C-LINK:) ; SYNTAX: C-FRAMEWORK: (C-FRAMEWORK:) ; SYNTAX: C-LINK/FRAMEWORK: - os macosx? [ (C-LINK:) ] [ (C-FRAMEWORK:) ] if ; + os macosx? [ (C-FRAMEWORK:) ] [ (C-LINK:) ] if ; SYNTAX: C-INCLUDE: "#include " scan append "c-library-vector" get push ; SYNTAX: C-FUNCTION: return-library-function-params - [ make-function define-declared ] + [ factor-function ] 4 nkeep (C-FUNCTION:) " {\n" append parse-here append "\n}\n" append "c-library-vector" get push ; diff --git a/basis/alien/compile/compile.factor b/basis/alien/compile/compile.factor index 6f1bc20545..b92fdb71ff 100644 --- a/basis/alien/compile/compile.factor +++ b/basis/alien/compile/compile.factor @@ -1,4 +1,4 @@ -USING: accessors arrays combinators generalizations +USING: accessors arrays combinators fry generalizations io.encodings.ascii io.files io.files.temp io.launcher kernel sequences system ; IN: alien.compile @@ -10,22 +10,30 @@ IN: alien.compile { [ dup windows? ] [ drop ".dll" ] } } cond ; -: compile-to-object ( compiler contents name -- ) - [ ".src" append ] [ ".o" append ] bi [ temp-file ] bi@ - [ tuck ascii set-file-contents ] dip - swap 2array { "-fPIC" "-c" "-o" } prepend - swap prefix try-process ; +: src-suffix ( lang -- str ) + { + { "C" [ ".c" ] } + { "C++" [ ".cpp" ] } + } case ; -: link-object ( compiler args name -- ) +: compile-to-object ( lang contents name -- ) + rot '[ _ src-suffix append ] [ ".o" append ] bi + [ temp-file ] bi@ + [ tuck ascii set-file-contents ] dip + swap 2array { "gcc" "-fPIC" "-c" "-o" } prepend + try-process ; + +: link-object ( args name -- ) [ "lib" prepend library-suffix append ] [ ".o" append ] bi [ temp-file ] bi@ 2array os { { [ dup linux? ] - [ drop { "-shared" "-o" } ] } + [ drop { "gcc" "-shared" "-o" } ] } { [ dup macosx? ] - [ drop { "-g" "-prebind" "-dynamiclib" "-o" } ] } + [ drop { "gcc" "-g" "-prebind" "-dynamiclib" "-o" } ] } [ name>> "unimplemented for: " prepend throw ] - } cond prepend prepend swap prefix try-process ; + } cond prepend prepend try-process ; -: compile-to-library ( compiler args contents name -- ) - [ [ nip ] dip compile-to-object ] 4 nkeep nip link-object ; +: compile-to-library ( lang args contents name -- ) + [ [ nip ] dip compile-to-object ] 4 nkeep + nip link-object drop ; From 4473ac992109425d27486966a606ebacf6370e64 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 07:41:18 +1200 Subject: [PATCH 04/15] alien.c-syntax alien.compile: added authors.txt --- basis/alien/c-syntax/authors.txt | 1 + basis/alien/compile/authors.txt | 1 + 2 files changed, 2 insertions(+) create mode 100644 basis/alien/c-syntax/authors.txt create mode 100644 basis/alien/compile/authors.txt diff --git a/basis/alien/c-syntax/authors.txt b/basis/alien/c-syntax/authors.txt new file mode 100644 index 0000000000..845910d5a0 --- /dev/null +++ b/basis/alien/c-syntax/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/basis/alien/compile/authors.txt b/basis/alien/compile/authors.txt new file mode 100644 index 0000000000..845910d5a0 --- /dev/null +++ b/basis/alien/compile/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes From 94f519b12cc8223791fdab52e86d5a6d6ade7872 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 10:32:39 +1200 Subject: [PATCH 05/15] alien.compile: use locals in some words --- basis/alien/compile/compile.factor | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/basis/alien/compile/compile.factor b/basis/alien/compile/compile.factor index b92fdb71ff..183b7372a7 100644 --- a/basis/alien/compile/compile.factor +++ b/basis/alien/compile/compile.factor @@ -1,6 +1,6 @@ USING: accessors arrays combinators fry generalizations io.encodings.ascii io.files io.files.temp io.launcher kernel -sequences system ; +locals sequences system ; IN: alien.compile : library-suffix ( -- str ) @@ -12,16 +12,15 @@ IN: alien.compile : src-suffix ( lang -- str ) { - { "C" [ ".c" ] } - { "C++" [ ".cpp" ] } + { C [ ".c" ] } + { C++ [ ".cpp" ] } } case ; -: compile-to-object ( lang contents name -- ) - rot '[ _ src-suffix append ] [ ".o" append ] bi - [ temp-file ] bi@ - [ tuck ascii set-file-contents ] dip - swap 2array { "gcc" "-fPIC" "-c" "-o" } prepend - try-process ; +:: compile-to-object ( lang contents name -- ) + name ".o" append temp-file + contents name lang src-suffix append temp-file + [ ascii set-file-contents ] keep 2array + { "gcc" "-fPIC" "-c" "-o" } prepend try-process ; : link-object ( args name -- ) [ "lib" prepend library-suffix append ] [ ".o" append ] bi @@ -34,6 +33,6 @@ IN: alien.compile [ name>> "unimplemented for: " prepend throw ] } cond prepend prepend try-process ; -: compile-to-library ( lang args contents name -- ) - [ [ nip ] dip compile-to-object ] 4 nkeep - nip link-object drop ; +:: compile-to-library ( lang args contents name -- ) + lang contents name compile-to-object + args name link-object ; From bb379a11caf862f76f8e23b41216c90c368eca6b Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 10:43:27 +1200 Subject: [PATCH 06/15] alien.c-syntax alien.compile: symbols instead of strings --- basis/alien/c-syntax/c-syntax.factor | 37 ++++++++++++++++------------ basis/alien/compile/compile.factor | 3 +++ 2 files changed, 24 insertions(+), 16 deletions(-) diff --git a/basis/alien/c-syntax/c-syntax.factor b/basis/alien/c-syntax/c-syntax.factor index 2d904c3c91..b29789b737 100644 --- a/basis/alien/c-syntax/c-syntax.factor +++ b/basis/alien/c-syntax/c-syntax.factor @@ -5,19 +5,24 @@ vocabs.loader vocabs.parser words ; IN: alien.c-syntax SYNTAX: C-LIBRARY: (C-LIBRARY:) ; -SYNTAX: COMPILE-AS-C++ t "library-is-c++" set ; +SYNTAX: COMPILE-AS-C++ t library-is-c++ set ; SYNTAX: C-LINK: (C-LINK:) ; @@ -64,13 +69,13 @@ SYNTAX: C-LINK/FRAMEWORK: os macosx? [ (C-FRAMEWORK:) ] [ (C-LINK:) ] if ; SYNTAX: C-INCLUDE: - "#include " scan append "c-library-vector" get push ; + "#include " scan append c-strings get push ; SYNTAX: C-FUNCTION: return-library-function-params [ factor-function ] 4 nkeep (C-FUNCTION:) " {\n" append parse-here append "\n}\n" append - "c-library-vector" get push ; + c-strings get push ; SYNTAX: ;C-LIBRARY (;C-LIBRARY) ; diff --git a/basis/alien/compile/compile.factor b/basis/alien/compile/compile.factor index 183b7372a7..a1b21e14aa 100644 --- a/basis/alien/compile/compile.factor +++ b/basis/alien/compile/compile.factor @@ -3,6 +3,9 @@ io.encodings.ascii io.files io.files.temp io.launcher kernel locals sequences system ; IN: alien.compile +SYMBOL: C +SYMBOL: C++ + : library-suffix ( -- str ) os { { [ dup macosx? ] [ drop ".dylib" ] } From f23e330f5801e94686cd0e39c74a97e9abdf9350 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 10:46:19 +1200 Subject: [PATCH 07/15] alien.c-syntax -> alien.inline, alien.compile -> alien.inline.compiler --- basis/alien/{c-syntax => inline}/authors.txt | 0 basis/alien/{compile => inline/compiler}/authors.txt | 0 .../compile.factor => inline/compiler/compiler.factor} | 2 +- .../{c-syntax/c-syntax.factor => inline/inline.factor} | 10 +++++----- 4 files changed, 6 insertions(+), 6 deletions(-) rename basis/alien/{c-syntax => inline}/authors.txt (100%) rename basis/alien/{compile => inline/compiler}/authors.txt (100%) rename basis/alien/{compile/compile.factor => inline/compiler/compiler.factor} (97%) rename basis/alien/{c-syntax/c-syntax.factor => inline/inline.factor} (88%) diff --git a/basis/alien/c-syntax/authors.txt b/basis/alien/inline/authors.txt similarity index 100% rename from basis/alien/c-syntax/authors.txt rename to basis/alien/inline/authors.txt diff --git a/basis/alien/compile/authors.txt b/basis/alien/inline/compiler/authors.txt similarity index 100% rename from basis/alien/compile/authors.txt rename to basis/alien/inline/compiler/authors.txt diff --git a/basis/alien/compile/compile.factor b/basis/alien/inline/compiler/compiler.factor similarity index 97% rename from basis/alien/compile/compile.factor rename to basis/alien/inline/compiler/compiler.factor index a1b21e14aa..4bda027f97 100644 --- a/basis/alien/compile/compile.factor +++ b/basis/alien/inline/compiler/compiler.factor @@ -1,7 +1,7 @@ USING: accessors arrays combinators fry generalizations io.encodings.ascii io.files io.files.temp io.launcher kernel locals sequences system ; -IN: alien.compile +IN: alien.inline.compiler SYMBOL: C SYMBOL: C++ diff --git a/basis/alien/c-syntax/c-syntax.factor b/basis/alien/inline/inline.factor similarity index 88% rename from basis/alien/c-syntax/c-syntax.factor rename to basis/alien/inline/inline.factor index b29789b737..4db562e5a2 100644 --- a/basis/alien/c-syntax/c-syntax.factor +++ b/basis/alien/inline/inline.factor @@ -1,8 +1,8 @@ -USING: accessors alien.compile alien.libraries alien.parser -arrays fry generalizations io.files io.files.info io.files.temp -kernel lexer math.order multiline namespaces sequences system -vocabs.loader vocabs.parser words ; -IN: alien.c-syntax +USING: accessors alien.inline.compiler alien.libraries +alien.parser arrays fry generalizations io.files io.files.info +io.files.temp kernel lexer math.order multiline namespaces +sequences system vocabs.loader vocabs.parser words ; +IN: alien.inline Date: Thu, 2 Jul 2009 17:52:53 -0500 Subject: [PATCH 08/15] half-floats: Add some more unit tests --- basis/compiler/tests/intrinsics.factor | 7 +++++++ extra/half-floats/half-floats-tests.factor | 1 + 2 files changed, 8 insertions(+) diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index d0cfc127e3..df7f1c8513 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -238,6 +238,13 @@ IN: compiler.tests.intrinsics [ t ] [ f [ f eq? ] compile-call ] unit-test +cell 8 = [ + [ HEX: 40400000 ] [ + HEX: 4200 [ HEX: 7fff fixnum-bitand 13 fixnum-shift-fast 112 23 fixnum-shift-fast fixnum+fast ] + compile-call + ] unit-test +] when + ! regression [ 3 ] [ 100001 f 3 100000 pick set-nth diff --git a/extra/half-floats/half-floats-tests.factor b/extra/half-floats/half-floats-tests.factor index 001cc6200b..3eff29635c 100644 --- a/extra/half-floats/half-floats-tests.factor +++ b/extra/half-floats/half-floats-tests.factor @@ -25,6 +25,7 @@ IN: half-floats.tests [ -1.5 ] [ HEX: be00 bits>half ] unit-test [ 1/0. ] [ HEX: 7c00 bits>half ] unit-test [ -1/0. ] [ HEX: fc00 bits>half ] unit-test +[ 3.0 ] [ HEX: 4200 bits>half ] unit-test [ t ] [ HEX: 7e00 bits>half fp-nan? ] unit-test C-STRUCT: halves From 80eb5068e2184ddd225b70f4be8d1084f4b49c73 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Jul 2009 17:55:35 -0500 Subject: [PATCH 09/15] fix bug in rewriting #add -- wasn't checking small-enough?, and change negative adds to subtractions/negative subtractions to adds --- .../value-numbering/rewrite/rewrite.factor | 63 +++++++++++-------- 1 file changed, 38 insertions(+), 25 deletions(-) mode change 100644 => 100755 basis/compiler/cfg/value-numbering/rewrite/rewrite.factor diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor old mode 100644 new mode 100755 index bdb906da79..418543603a --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators combinators.short-circuit -compiler.cfg.hats compiler.cfg.instructions +arrays compiler.cfg.hats compiler.cfg.instructions compiler.cfg.value-numbering.expressions compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.simplify fry kernel layouts math -namespaces sequences cpu.architecture math.bitwise locals ; +namespaces sequences cpu.architecture math.bitwise ; IN: compiler.cfg.value-numbering.rewrite GENERIC: rewrite ( insn -- insn' ) @@ -113,38 +113,45 @@ M: ##compare-imm rewrite ] when ] when ; +: (new-imm-insn) ( insn dst src1 n op -- new-insn/insn ) + [ cell-bits bits ] dip over small-enough? [ + new-insn dup number-values nip + ] [ + 2drop 2drop + ] if ; inline + +: new-imm-insn ( insn dst src n op -- n' op' ) + 2dup [ sgn ] dip 2array + { + { { -1 ##add-imm } [ drop neg \ ##sub-imm (new-imm-insn) ] } + { { -1 ##sub-imm } [ drop neg \ ##add-imm (new-imm-insn) ] } + [ drop (new-imm-insn) ] + } case ; inline + : combine-imm? ( insn op -- ? ) [ src1>> vreg>expr op>> ] dip = ; -:: combine-imm ( insn quot op -- insn ) - insn - [ dst>> ] - [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] - [ src2>> ] tri - - quot call cell-bits bits - - dup small-enough? [ - op new-insn dup number-values - ] [ - 3drop insn - ] if ; inline +: combine-imm ( insn quot op -- insn ) + [ + { + [ ] + [ dst>> ] + [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] + [ src2>> ] + } cleave + ] [ call ] [ ] tri* new-imm-insn ; inline M: ##add-imm rewrite { - { [ dup \ ##add-imm combine-imm? ] - [ [ + ] \ ##add-imm combine-imm ] } - { [ dup \ ##sub-imm combine-imm? ] - [ [ - ] \ ##sub-imm combine-imm ] } + { [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm combine-imm ] } + { [ dup \ ##sub-imm combine-imm? ] [ [ - ] \ ##sub-imm combine-imm ] } [ ] } cond ; M: ##sub-imm rewrite { - { [ dup \ ##add-imm combine-imm? ] - [ [ - ] \ ##add-imm combine-imm ] } - { [ dup \ ##sub-imm combine-imm? ] - [ [ + ] \ ##sub-imm combine-imm ] } + { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm combine-imm ] } + { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm combine-imm ] } [ ] } cond ; @@ -169,8 +176,14 @@ M: ##xor-imm rewrite dup \ ##xor-imm combine-imm? [ [ bitxor ] \ ##xor-imm combine-imm ] when ; +: rewrite-add>add-imm? ( insn -- ? ) + src2>> { + [ vreg>expr constant-expr? ] + [ vreg>constant small-enough? ] + } 1&& ; + M: ##add rewrite - dup src2>> vreg>expr constant-expr? [ + dup rewrite-add>add-imm? [ [ dst>> ] [ src1>> ] [ src2>> vreg>constant ] tri \ ##add-imm new-insn From e11e3cf6d28a2807035212a0d9d28e728fdcf4d2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Jul 2009 18:01:00 -0500 Subject: [PATCH 10/15] unit test to make sure adds are not optimized incorrectly --- .../cfg/optimizer/optimizer-tests.factor | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/basis/compiler/cfg/optimizer/optimizer-tests.factor b/basis/compiler/cfg/optimizer/optimizer-tests.factor index ee601f2337..97ebc7cc3e 100644 --- a/basis/compiler/cfg/optimizer/optimizer-tests.factor +++ b/basis/compiler/cfg/optimizer/optimizer-tests.factor @@ -1,7 +1,8 @@ -USING: arrays sequences tools.test compiler.cfg.checker -compiler.cfg.debugger compiler.cfg.def-use sets kernel -kernel.private fry slots.private vectors sequences.private -math sbufs math.private strings ; +USING: accessors arrays compiler.cfg.checker +compiler.cfg.debugger compiler.cfg.def-use +compiler.cfg.instructions fry kernel kernel.private math +math.private sbufs sequences sequences.private sets +slots.private strings tools.test vectors ; IN: compiler.cfg.optimizer.tests ! Miscellaneous tests @@ -33,3 +34,11 @@ IN: compiler.cfg.optimizer.tests } [ [ [ ] ] dip '[ _ test-mr first check-mr ] unit-test ] each + +[ t ] +[ + [ + HEX: 7fff fixnum-bitand 13 fixnum-shift-fast + 112 23 fixnum-shift-fast fixnum+fast + ] test-mr first instructions>> [ ##add? ] any? +] unit-test From 559a77be43e7981214c9709079c61be45fe70599 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Jul 2009 18:05:55 -0500 Subject: [PATCH 11/15] fix a unit test so it's sure to overflow 64bit machines --- basis/compiler/cfg/optimizer/optimizer-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/cfg/optimizer/optimizer-tests.factor b/basis/compiler/cfg/optimizer/optimizer-tests.factor index 97ebc7cc3e..646ec4ab61 100644 --- a/basis/compiler/cfg/optimizer/optimizer-tests.factor +++ b/basis/compiler/cfg/optimizer/optimizer-tests.factor @@ -39,6 +39,6 @@ IN: compiler.cfg.optimizer.tests [ [ HEX: 7fff fixnum-bitand 13 fixnum-shift-fast - 112 23 fixnum-shift-fast fixnum+fast + 112 203 fixnum-shift-fast fixnum+fast ] test-mr first instructions>> [ ##add? ] any? ] unit-test From f11ba00667b0abbfc55a6492741a46d97c9eb607 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Jul 2009 18:18:50 -0500 Subject: [PATCH 12/15] Revert "fix a unit test so it's sure to overflow 64bit machines" This reverts commit 88a545a215d44b37f95c926b569593b1d1ddbb32. --- basis/compiler/cfg/optimizer/optimizer-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/compiler/cfg/optimizer/optimizer-tests.factor b/basis/compiler/cfg/optimizer/optimizer-tests.factor index 646ec4ab61..97ebc7cc3e 100644 --- a/basis/compiler/cfg/optimizer/optimizer-tests.factor +++ b/basis/compiler/cfg/optimizer/optimizer-tests.factor @@ -39,6 +39,6 @@ IN: compiler.cfg.optimizer.tests [ [ HEX: 7fff fixnum-bitand 13 fixnum-shift-fast - 112 203 fixnum-shift-fast fixnum+fast + 112 23 fixnum-shift-fast fixnum+fast ] test-mr first instructions>> [ ##add? ] any? ] unit-test From 450b5ff4f10e925118291edf2c149ca5c6a27ebc Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 11:35:02 +1200 Subject: [PATCH 13/15] Added copyright headers --- basis/alien/inline/compiler/compiler.factor | 2 ++ basis/alien/inline/inline.factor | 2 ++ 2 files changed, 4 insertions(+) diff --git a/basis/alien/inline/compiler/compiler.factor b/basis/alien/inline/compiler/compiler.factor index 4bda027f97..0ac702478b 100644 --- a/basis/alien/inline/compiler/compiler.factor +++ b/basis/alien/inline/compiler/compiler.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators fry generalizations io.encodings.ascii io.files io.files.temp io.launcher kernel locals sequences system ; diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index 4db562e5a2..5e235fe74e 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.inline.compiler alien.libraries alien.parser arrays fry generalizations io.files io.files.info io.files.temp kernel lexer math.order multiline namespaces From c286074fe56c53a19f16c20bc5778bdc7e5a739d Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Fri, 3 Jul 2009 11:35:46 +1200 Subject: [PATCH 14/15] Unit tests for alien.inline --- basis/alien/inline/tests/tests.factor | 47 +++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 basis/alien/inline/tests/tests.factor diff --git a/basis/alien/inline/tests/tests.factor b/basis/alien/inline/tests/tests.factor new file mode 100644 index 0000000000..aea41ea8b8 --- /dev/null +++ b/basis/alien/inline/tests/tests.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test alien.inline alien.inline.private io.files io.directories kernel ; +IN: alien.inline.tests + +C-LIBRARY: const + +C-FUNCTION: const-int add ( int a, int b ) + return a + b; +; + +;C-LIBRARY + +{ 2 1 } [ add ] must-infer-as +[ 5 ] [ 2 3 add ] unit-test + +<< library-path dup exists? [ delete-file ] [ drop ] if >> + + +C-LIBRARY: cpplib + +COMPILE-AS-C++ + +C-INCLUDE: + +C-FUNCTION: const-char* hello ( ) + std::string s("hello world"); + return s.c_str(); +; + +;C-LIBRARY + +{ 0 1 } [ hello ] must-infer-as +[ "hello world" ] [ hello ] unit-test + +<< library-path dup exists? [ delete-file ] [ drop ] if >> + + +C-LIBRARY: compile-error + +C-FUNCTION: char* breakme ( ) + return not a string; +; + +<< [ (;C-LIBRARY) ] must-fail >> + +<< library-path dup exists? [ delete-file ] [ drop ] if >> From e7a227ad40d261741285705154e39e2fee5efd64 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Jul 2009 19:03:21 -0500 Subject: [PATCH 15/15] add constant folding for integer ops, refactor some rewrites --- .../value-numbering/rewrite/rewrite.factor | 50 +++++++++++-------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index 418543603a..bbfeb3f8bf 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -5,7 +5,7 @@ arrays compiler.cfg.hats compiler.cfg.instructions compiler.cfg.value-numbering.expressions compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.simplify fry kernel layouts math -namespaces sequences cpu.architecture math.bitwise ; +namespaces sequences cpu.architecture math.bitwise locals ; IN: compiler.cfg.value-numbering.rewrite GENERIC: rewrite ( insn -- insn' ) @@ -113,12 +113,20 @@ M: ##compare-imm rewrite ] when ] when ; +: constant-fold ( insn -- insn' ) + dup dst>> vreg>expr dup constant-expr? [ + [ dst>> ] [ value>> ] bi* \ ##load-immediate new-insn + dup number-values + ] [ + drop + ] if ; + : (new-imm-insn) ( insn dst src1 n op -- new-insn/insn ) [ cell-bits bits ] dip over small-enough? [ new-insn dup number-values nip ] [ 2drop 2drop - ] if ; inline + ] if constant-fold ; inline : new-imm-insn ( insn dst src n op -- n' op' ) 2dup [ sgn ] dip 2array @@ -131,7 +139,7 @@ M: ##compare-imm rewrite : combine-imm? ( insn op -- ? ) [ src1>> vreg>expr op>> ] dip = ; -: combine-imm ( insn quot op -- insn ) +: (combine-imm) ( insn quot op -- insn ) [ { [ ] @@ -141,17 +149,24 @@ M: ##compare-imm rewrite } cleave ] [ call ] [ ] tri* new-imm-insn ; inline +:: combine-imm ( insn quot op -- insn ) + insn op combine-imm? [ + insn quot op (combine-imm) + ] [ + insn + ] if ; inline + M: ##add-imm rewrite { - { [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm combine-imm ] } - { [ dup \ ##sub-imm combine-imm? ] [ [ - ] \ ##sub-imm combine-imm ] } + { [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm (combine-imm) ] } + { [ dup \ ##sub-imm combine-imm? ] [ [ - ] \ ##sub-imm (combine-imm) ] } [ ] } cond ; M: ##sub-imm rewrite { - { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm combine-imm ] } - { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm combine-imm ] } + { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm (combine-imm) ] } + { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm (combine-imm) ] } [ ] } cond ; @@ -160,32 +175,27 @@ M: ##mul-imm rewrite [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn dup number-values ] [ - drop dup \ ##mul-imm combine-imm? - [ [ * ] \ ##mul-imm combine-imm ] when + drop [ * ] \ ##mul-imm combine-imm ] if ; -M: ##and-imm rewrite - dup \ ##and-imm combine-imm? - [ [ bitand ] \ ##and-imm combine-imm ] when ; +M: ##and-imm rewrite [ bitand ] \ ##and-imm combine-imm ; -M: ##or-imm rewrite - dup \ ##or-imm combine-imm? - [ [ bitor ] \ ##or-imm combine-imm ] when ; +M: ##or-imm rewrite [ bitor ] \ ##or-imm combine-imm ; -M: ##xor-imm rewrite - dup \ ##xor-imm combine-imm? - [ [ bitxor ] \ ##xor-imm combine-imm ] when ; +M: ##xor-imm rewrite [ bitxor ] \ ##xor-imm combine-imm ; -: rewrite-add>add-imm? ( insn -- ? ) +: rewrite-add? ( insn -- ? ) src2>> { [ vreg>expr constant-expr? ] [ vreg>constant small-enough? ] } 1&& ; M: ##add rewrite - dup rewrite-add>add-imm? [ + dup rewrite-add? [ [ dst>> ] [ src1>> ] [ src2>> vreg>constant ] tri \ ##add-imm new-insn dup number-values ] when ; + +M: ##sub rewrite constant-fold ;