Merge branch 'master' of git://factorcode.org/git/factor
commit
605068df93
|
@ -389,4 +389,10 @@ DEFER: loop-bbb
|
|||
|
||||
[ f ] [ \ broken-declaration optimized? ] unit-test
|
||||
|
||||
[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test
|
||||
[ ] [ [ \ 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
|
|
@ -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
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
[ ] [ circle new dup >>me 1quotation final-info drop ] unit-test
|
||||
|
||||
! Joe found an oversight
|
||||
[ V{ integer } ] [ [ >integer ] final-classes ] unit-test
|
|
@ -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 ]
|
||||
|
|
|
@ -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<heap_block *,char *> &forwarding)
|
||||
cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &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<heap_block *,char *> &forwarding)
|
||||
void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
|
||||
{
|
||||
heap_block *scan = first_block(heap);
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue