Merge branch 'master' of git://factorcode.org/git/factor
commit
762a8c32cb
|
@ -56,7 +56,8 @@ PRIVATE>
|
||||||
: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
|
: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
|
||||||
|
|
||||||
: random-prime ( numbits -- p )
|
: random-prime ( numbits -- p )
|
||||||
random-bits* next-prime ;
|
[ ] [ 2^ ] [ random-bits* next-prime ] tri
|
||||||
|
2dup < [ 2drop random-prime ] [ 2nip ] if ;
|
||||||
|
|
||||||
: estimated-primes ( m -- n )
|
: estimated-primes ( m -- n )
|
||||||
dup log / ; foldable
|
dup log / ; foldable
|
||||||
|
|
|
@ -3,7 +3,8 @@
|
||||||
USING: tools.disassembler namespaces combinators
|
USING: tools.disassembler namespaces combinators
|
||||||
alien alien.syntax alien.c-types lexer parser kernel
|
alien alien.syntax alien.c-types lexer parser kernel
|
||||||
sequences layouts math math.order alien.libraries
|
sequences layouts math math.order alien.libraries
|
||||||
math.parser system make fry arrays libc destructors ;
|
math.parser system make fry arrays libc destructors
|
||||||
|
tools.disassembler.utils splitting ;
|
||||||
IN: tools.disassembler.udis
|
IN: tools.disassembler.udis
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
@ -103,19 +104,21 @@ FUNCTION: char* ud_lookup_mnemonic ( int c ) ;
|
||||||
dup UD_SYN_INTEL ud_set_syntax ;
|
dup UD_SYN_INTEL ud_set_syntax ;
|
||||||
|
|
||||||
: with-ud ( quot: ( ud -- ) -- )
|
: with-ud ( quot: ( ud -- ) -- )
|
||||||
[ [ <ud> ] dip call ] with-destructors ; inline
|
[ [ [ <ud> ] dip call ] with-destructors ] with-words-xt ; inline
|
||||||
|
|
||||||
SINGLETON: udis-disassembler
|
SINGLETON: udis-disassembler
|
||||||
|
|
||||||
: buf/len ( from to -- buf len ) [ drop <alien> ] [ swap - ] 2bi ;
|
: buf/len ( from to -- buf len ) [ drop <alien> ] [ swap - ] 2bi ;
|
||||||
|
|
||||||
|
: resolve-call ( str -- str' ) "0x" split1-last [ resolve-xt append ] when* ;
|
||||||
|
|
||||||
: format-disassembly ( lines -- lines' )
|
: format-disassembly ( lines -- lines' )
|
||||||
dup [ second length ] [ max ] map-reduce
|
dup [ second length ] [ max ] map-reduce
|
||||||
'[
|
'[
|
||||||
[
|
[
|
||||||
[ first >hex cell 2 * CHAR: 0 pad-head % ": " % ]
|
[ first >hex cell 2 * CHAR: 0 pad-head % ": " % ]
|
||||||
[ second _ CHAR: \s pad-tail % " " % ]
|
[ second _ CHAR: \s pad-tail % " " % ]
|
||||||
[ third % ]
|
[ third resolve-call % ]
|
||||||
tri
|
tri
|
||||||
] "" make
|
] "" make
|
||||||
] map ;
|
] map ;
|
||||||
|
|
|
@ -0,0 +1,41 @@
|
||||||
|
USING: accessors arrays binary-search kernel math math.order
|
||||||
|
math.parser namespaces sequences sorting splitting vectors vocabs words ;
|
||||||
|
IN: tools.disassembler.utils
|
||||||
|
|
||||||
|
SYMBOL: words-xt
|
||||||
|
SYMBOL: smallest-xt
|
||||||
|
SYMBOL: greatest-xt
|
||||||
|
|
||||||
|
: (words-xt) ( -- assoc )
|
||||||
|
vocabs [ words ] map concat [ [ word-xt ] keep 3array ] map
|
||||||
|
[ [ first ] bi@ <=> ] sort >vector ;
|
||||||
|
|
||||||
|
: complete-address ( n seq -- str )
|
||||||
|
[ first - ] [ third name>> ] bi
|
||||||
|
over zero? [ nip ] [ swap 16 >base "0x" prepend "+" glue ] if ;
|
||||||
|
|
||||||
|
: search-xt ( n -- str/f )
|
||||||
|
dup [ smallest-xt get < ] [ greatest-xt get > ] bi or [
|
||||||
|
drop f
|
||||||
|
] [
|
||||||
|
words-xt get over [ swap first <=> ] curry search nip
|
||||||
|
2dup second <= [
|
||||||
|
[ complete-address ] [ drop f ] if*
|
||||||
|
] [
|
||||||
|
2drop f
|
||||||
|
] if
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: resolve-xt ( str -- str' )
|
||||||
|
[ "0x" prepend ] [ 16 base> ] bi
|
||||||
|
[ search-xt [ " (" ")" surround append ] when* ] when* ;
|
||||||
|
|
||||||
|
: resolve-call ( str -- str' )
|
||||||
|
"0x" split1-last [ resolve-xt "0x" glue ] when* ;
|
||||||
|
|
||||||
|
: with-words-xt ( quot -- )
|
||||||
|
[ (words-xt)
|
||||||
|
[ words-xt set ]
|
||||||
|
[ first first smallest-xt set ]
|
||||||
|
[ last second greatest-xt set ] tri
|
||||||
|
] prepose with-scope ; inline
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors classes.struct combinators.smart fry kernel
|
USING: accessors classes.struct combinators.smart fry kernel
|
||||||
math math.functions math.order math.parser sequences
|
math math.functions math.order math.parser sequences
|
||||||
struct-arrays hints io ;
|
struct-arrays io ;
|
||||||
IN: benchmark.struct-arrays
|
IN: benchmark.struct-arrays
|
||||||
|
|
||||||
STRUCT: point { x float } { y float } { z float } ;
|
STRUCT: point { x float } { y float } { z float } ;
|
||||||
|
@ -45,8 +45,6 @@ STRUCT: point { x float } { y float } { z float } ;
|
||||||
: struct-array-benchmark ( len -- )
|
: struct-array-benchmark ( len -- )
|
||||||
make-points [ normalize-points ] [ max-points ] bi print-point ;
|
make-points [ normalize-points ] [ max-points ] bi print-point ;
|
||||||
|
|
||||||
HINTS: struct-array-benchmark fixnum ;
|
|
||||||
|
|
||||||
: main ( -- ) 5000000 struct-array-benchmark ;
|
: main ( -- ) 5000000 struct-array-benchmark ;
|
||||||
|
|
||||||
MAIN: main
|
MAIN: main
|
||||||
|
|
|
@ -4,7 +4,7 @@ IN: benchmark.terrain-generation
|
||||||
|
|
||||||
: terrain-generation-benchmark ( -- )
|
: terrain-generation-benchmark ( -- )
|
||||||
"Generating terrain segment..." write flush yield
|
"Generating terrain segment..." write flush yield
|
||||||
<terrain> { 0.0 0.0 } terrain-segment drop
|
<terrain> { 0 0 } terrain-segment drop
|
||||||
"done" print ;
|
"done" print ;
|
||||||
|
|
||||||
MAIN: terrain-generation-benchmark
|
MAIN: terrain-generation-benchmark
|
||||||
|
|
Loading…
Reference in New Issue