Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2009-08-29 22:59:24 -05:00
commit 762a8c32cb
5 changed files with 51 additions and 8 deletions

View File

@ -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

View File

@ -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 ;

View File

@ -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

View File

@ -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

View File

@ -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