From 466533d509337ffb4f4c42cd4d13d169c2f10d3d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 12:32:06 -0500 Subject: [PATCH 1/3] Fix overly-eager strength reduction for mod, and add a type function for >integer (reported by Joe Groff) --- .../known-words/known-words.factor | 19 ++++++++++++------- .../tree/propagation/propagation-tests.factor | 5 ++++- 2 files changed, 16 insertions(+), 8 deletions(-) diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index b91a1157f7..2f5c166ac5 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/basis/compiler/tree/propagation/known-words/known-words.factor @@ -148,10 +148,6 @@ most-negative-fixnum most-positive-fixnum [a,b] comparison-ops [ dup '[ _ define-comparison-constraints ] each-derived-op ] each -! generic-comparison-ops [ -! dup specific-comparison define-comparison-constraints -! ] each - ! Remove redundant comparisons : fold-comparison ( info1 info2 word -- info ) [ [ interval>> ] bi@ ] dip interval-comparison { @@ -217,6 +213,8 @@ generic-comparison-ops [ { >float float } { fixnum>float float } { bignum>float float } + + { >integer integer } } [ '[ _ @@ -228,19 +226,26 @@ generic-comparison-ops [ ] "outputs" set-word-prop ] assoc-each +: rem-custom-inlining ( #call -- quot/f ) + second value-info literal>> dup integer? + [ power-of-2? [ 1- bitand ] f ? ] [ drop f ] if ; + { mod-integer-integer mod-integer-fixnum mod-fixnum-integer fixnum-mod - rem } [ [ - in-d>> second value-info >literal< - [ dup integer? [ power-of-2? [ 1- bitand ] f ? ] [ drop f ] if ] when + in-d>> dup first value-info interval>> [0,inf] interval-subset? + [ rem-custom-inlining ] [ drop f ] if ] "custom-inlining" set-word-prop ] each +\ rem [ + in-d>> rem-custom-inlining +] "custom-inlining" set-word-prop + { bitand-integer-integer bitand-integer-fixnum diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index eba41dbfdf..aba8dc9eda 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -690,4 +690,7 @@ TUPLE: littledan-2 { from read-only } { to read-only } ; ! Mutable tuples with circularity should not cause problems TUPLE: circle me ; -[ ] [ circle new dup >>me 1quotation final-info drop ] unit-test \ No newline at end of file +[ ] [ circle new dup >>me 1quotation final-info drop ] unit-test + +! Joe found an oversight +[ V{ integer } ] [ [ >integer ] final-classes ] unit-test \ No newline at end of file From d7b40d72a0b513f65ae235ac1b41c88009150652 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 12:33:31 -0500 Subject: [PATCH 2/3] Code cleanups --- basis/math/intervals/intervals.factor | 6 ++++-- vm/code_gc.cpp | 4 ++-- vm/cpu-x86.32.S | 8 ++------ vm/cpu-x86.64.S | 4 ++-- 4 files changed, 10 insertions(+), 12 deletions(-) diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 0bc25605e7..767197a975 100755 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -48,6 +48,8 @@ TUPLE: interval { from read-only } { to read-only } ; : (a,inf] ( a -- interval ) 1/0. (a,b] ; inline +: [0,inf] ( -- interval ) 0 [a,inf] ; foldable + : [-inf,inf] ( -- interval ) full-interval ; inline : compare-endpoints ( p1 p2 quot -- ? ) @@ -262,7 +264,7 @@ TUPLE: interval { from read-only } { to read-only } ; : interval-abs ( i1 -- i2 ) { { [ dup empty-interval eq? ] [ ] } - { [ dup full-interval eq? ] [ drop 0 [a,inf] ] } + { [ dup full-interval eq? ] [ drop [0,inf] ] } { [ 0 over interval-contains? ] [ (interval-abs) { 0 t } suffix points>interval ] } [ (interval-abs) points>interval ] } cond ; @@ -376,7 +378,7 @@ SYMBOL: incomparable : interval-log2 ( i1 -- i2 ) { { empty-interval [ empty-interval ] } - { full-interval [ 0 [a,inf] ] } + { full-interval [ [0,inf] ] } [ to>> first 1 max dup most-positive-fixnum > [ drop full-interval interval-log2 ] diff --git a/vm/code_gc.cpp b/vm/code_gc.cpp index 59110d13f8..48cf8f7661 100755 --- a/vm/code_gc.cpp +++ b/vm/code_gc.cpp @@ -303,7 +303,7 @@ cell heap_size(heap *heap) } /* Compute where each block is going to go, after compaction */ - cell compute_heap_forwarding(heap *heap, unordered_map &forwarding) +cell compute_heap_forwarding(heap *heap, unordered_map &forwarding) { heap_block *scan = first_block(heap); char *address = (char *)first_block(heap); @@ -324,7 +324,7 @@ cell heap_size(heap *heap) return (cell)address - heap->seg->start; } - void compact_heap(heap *heap, unordered_map &forwarding) +void compact_heap(heap *heap, unordered_map &forwarding) { heap_block *scan = first_block(heap); diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S index a1ce83932e..ff45f48066 100755 --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -1,9 +1,5 @@ #include "asm.h" -/* Note that primitive word definitions are compiled with -__attribute__((regparm 2), so the pointer to the word object is passed in EAX, -and the callstack top is passed in EDX */ - #define ARG0 %eax #define ARG1 %edx #define STACK_REG %esp @@ -59,9 +55,9 @@ DEF(bool,check_sse2,(void)): mov %edx,%eax ret -DEF(F_FASTCALL void,primitive_inline_cache_miss,(void)): +DEF(void,primitive_inline_cache_miss,(void)): mov (%esp),%ebx -DEF(F_FASTCALL void,primitive_inline_cache_miss_tail,(void)): +DEF(void,primitive_inline_cache_miss_tail,(void)): sub $8,%esp push %ebx call MANGLE(inline_cache_miss) diff --git a/vm/cpu-x86.64.S b/vm/cpu-x86.64.S index 0ace354308..6b2faa1c0b 100644 --- a/vm/cpu-x86.64.S +++ b/vm/cpu-x86.64.S @@ -72,9 +72,9 @@ DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, voi call *ARG3 /* call memcpy */ ret /* return _with new stack_ */ -DEF(F_FASTCALL void,primitive_inline_cache_miss,(void)): +DEF(void,primitive_inline_cache_miss,(void)): mov (%rsp),%rbx -DEF(F_FASTCALL void,primitive_inline_cache_miss_tail,(void)): +DEF(void,primitive_inline_cache_miss_tail,(void)): sub $STACK_PADDING,%rsp mov %rbx,ARG0 call MANGLE(inline_cache_miss) From 75d9946bd74980b3e31959af29147207c1c76177 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 7 May 2009 12:54:23 -0500 Subject: [PATCH 3/3] compiler.tree.modular-arithmetic: convert >integer >fixnum into >fixnum --- basis/compiler/tests/optimizer.factor | 8 +++++++- .../modular-arithmetic/modular-arithmetic-tests.factor | 10 +++++++++- .../tree/modular-arithmetic/modular-arithmetic.factor | 8 ++++++++ 3 files changed, 24 insertions(+), 2 deletions(-) diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index f19a950711..fa1248435b 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -389,4 +389,10 @@ DEFER: loop-bbb [ f ] [ \ broken-declaration optimized? ] unit-test -[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test \ No newline at end of file +[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test + +! Modular arithmetic bug +: modular-arithmetic-bug ( a -- b ) >integer 256 mod ; + +[ 1 ] [ 257 modular-arithmetic-bug ] unit-test +[ -10 ] [ -10 modular-arithmetic-bug ] unit-test \ No newline at end of file diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor index 5d6a9cdea1..6e1c32d89d 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor @@ -98,13 +98,18 @@ TUPLE: declared-fixnum { x fixnum } ; ] { mod fixnum-mod } inlined? ] unit-test - [ f ] [ [ 256 mod ] { mod fixnum-mod } inlined? ] unit-test +[ f ] [ + [ + >fixnum 256 mod + ] { mod fixnum-mod } inlined? +] unit-test + [ f ] [ [ dup 0 >= [ 256 mod ] when @@ -128,3 +133,6 @@ TUPLE: declared-fixnum { x fixnum } ; { integer } declare [ 256 rem ] map ] { mod fixnum-mod rem } inlined? ] unit-test + +[ [ >fixnum 255 fixnum-bitand ] ] +[ [ >integer 256 rem ] test-modular-arithmetic ] unit-test \ No newline at end of file diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor index de2600f691..31939a0d22 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: math math.partial-dispatch namespaces sequences sets accessors assocs words kernel memoize fry combinators +combinators.short-circuit compiler.tree compiler.tree.combinators compiler.tree.def-use @@ -69,6 +70,12 @@ GENERIC: optimize-modular-arithmetic* ( node -- nodes ) : optimize->fixnum ( #call -- nodes ) dup redundant->fixnum? [ drop f ] when ; +: optimize->integer ( #call -- nodes ) + dup out-d>> first actually-used-by dup length 1 = [ + first node>> { [ #call? ] [ word>> \ >fixnum eq? ] } 1&& + [ drop { } ] when + ] [ drop ] if ; + MEMO: fixnum-coercion ( flags -- nodes ) [ [ ] [ >fixnum ] ? ] map '[ _ spread ] splice-quot ; @@ -87,6 +94,7 @@ MEMO: fixnum-coercion ( flags -- nodes ) M: #call optimize-modular-arithmetic* dup word>> { { [ dup \ >fixnum eq? ] [ drop optimize->fixnum ] } + { [ dup \ >integer eq? ] [ drop optimize->integer ] } { [ dup "modular-arithmetic" word-prop ] [ drop optimize-modular-op ] } [ drop ] } cond ;