Merge branch 'master' of git://factorcode.org/git/factor
commit
762a8c32cb
|
@ -56,7 +56,8 @@ PRIVATE>
|
|||
: coprime? ( a b -- ? ) gcd nip 1 = ; foldable
|
||||
|
||||
: random-prime ( numbits -- p )
|
||||
random-bits* next-prime ;
|
||||
[ ] [ 2^ ] [ random-bits* next-prime ] tri
|
||||
2dup < [ 2drop random-prime ] [ 2nip ] if ;
|
||||
|
||||
: estimated-primes ( m -- n )
|
||||
dup log / ; foldable
|
||||
|
|
|
@ -3,7 +3,8 @@
|
|||
USING: tools.disassembler namespaces combinators
|
||||
alien alien.syntax alien.c-types lexer parser kernel
|
||||
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
|
||||
|
||||
<<
|
||||
|
@ -103,19 +104,21 @@ FUNCTION: char* ud_lookup_mnemonic ( int c ) ;
|
|||
dup UD_SYN_INTEL ud_set_syntax ;
|
||||
|
||||
: with-ud ( quot: ( ud -- ) -- )
|
||||
[ [ <ud> ] dip call ] with-destructors ; inline
|
||||
[ [ [ <ud> ] dip call ] with-destructors ] with-words-xt ; inline
|
||||
|
||||
SINGLETON: udis-disassembler
|
||||
|
||||
: 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' )
|
||||
dup [ second length ] [ max ] map-reduce
|
||||
'[
|
||||
[
|
||||
[ first >hex cell 2 * CHAR: 0 pad-head % ": " % ]
|
||||
[ second _ CHAR: \s pad-tail % " " % ]
|
||||
[ third % ]
|
||||
[ third resolve-call % ]
|
||||
tri
|
||||
] "" make
|
||||
] 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.
|
||||
USING: accessors classes.struct combinators.smart fry kernel
|
||||
math math.functions math.order math.parser sequences
|
||||
struct-arrays hints io ;
|
||||
struct-arrays io ;
|
||||
IN: benchmark.struct-arrays
|
||||
|
||||
STRUCT: point { x float } { y float } { z float } ;
|
||||
|
@ -45,8 +45,6 @@ STRUCT: point { x float } { y float } { z float } ;
|
|||
: struct-array-benchmark ( len -- )
|
||||
make-points [ normalize-points ] [ max-points ] bi print-point ;
|
||||
|
||||
HINTS: struct-array-benchmark fixnum ;
|
||||
|
||||
: main ( -- ) 5000000 struct-array-benchmark ;
|
||||
|
||||
MAIN: main
|
||||
|
|
|
@ -4,7 +4,7 @@ IN: benchmark.terrain-generation
|
|||
|
||||
: terrain-generation-benchmark ( -- )
|
||||
"Generating terrain segment..." write flush yield
|
||||
<terrain> { 0.0 0.0 } terrain-segment drop
|
||||
<terrain> { 0 0 } terrain-segment drop
|
||||
"done" print ;
|
||||
|
||||
MAIN: terrain-generation-benchmark
|
||||
|
|
Loading…
Reference in New Issue