From 6a658506085fae99c827d7c7a4a1f714bb45cbc0 Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Mon, 22 Jun 2009 23:06:07 +0200 Subject: [PATCH 1/4] WIP: crude xt>name disassembler help --- basis/tools/disassembler/udis/udis.factor | 9 +++-- basis/tools/disassembler/utils/utils.factor | 41 +++++++++++++++++++++ 2 files changed, 47 insertions(+), 3 deletions(-) create mode 100644 basis/tools/disassembler/utils/utils.factor diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index df624cab28..2f0456ab62 100755 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -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 -- ) -- ) - [ [ ] dip call ] with-destructors ; inline + [ [ [ ] dip call ] with-destructors ] with-words-xt ; inline SINGLETON: udis-disassembler : buf/len ( from to -- buf len ) [ drop ] [ 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 ; diff --git a/basis/tools/disassembler/utils/utils.factor b/basis/tools/disassembler/utils/utils.factor new file mode 100644 index 0000000000..fb936cf08a --- /dev/null +++ b/basis/tools/disassembler/utils/utils.factor @@ -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 From e5897d52b26cc6196e73e41f8c29eb155b14ebcb Mon Sep 17 00:00:00 2001 From: Samuel Tardieu Date: Sat, 29 Aug 2009 21:42:15 +0200 Subject: [PATCH 2/4] Ensure that random-prime result has the right size As noted by Slava, choosing the next prime following a random number with a specified number of bits may give a number one more bit long. --- basis/math/primes/primes.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor index 7e877a03ce..27743a4a85 100644 --- a/basis/math/primes/primes.factor +++ b/basis/math/primes/primes.factor @@ -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 From 9d61c162e2fcb20593344fc8dd3653a3e1da14d9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Aug 2009 21:23:35 -0500 Subject: [PATCH 3/4] benchmark.struct-arrays: doesn't actually need HINTS: --- extra/benchmark/struct-arrays/struct-arrays.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/extra/benchmark/struct-arrays/struct-arrays.factor b/extra/benchmark/struct-arrays/struct-arrays.factor index 827604a39e..faed2f4dca 100644 --- a/extra/benchmark/struct-arrays/struct-arrays.factor +++ b/extra/benchmark/struct-arrays/struct-arrays.factor @@ -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 From dca528eaef4fa5cab9262642ed6c697394a627e1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 29 Aug 2009 22:09:51 -0500 Subject: [PATCH 4/4] benchmark.terrain-generation: fix type error --- extra/benchmark/terrain-generation/terrain-generation.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/benchmark/terrain-generation/terrain-generation.factor b/extra/benchmark/terrain-generation/terrain-generation.factor index 7fbb0ff43f..623a905bbc 100644 --- a/extra/benchmark/terrain-generation/terrain-generation.factor +++ b/extra/benchmark/terrain-generation/terrain-generation.factor @@ -4,7 +4,7 @@ IN: benchmark.terrain-generation : terrain-generation-benchmark ( -- ) "Generating terrain segment..." write flush yield - { 0.0 0.0 } terrain-segment drop + { 0 0 } terrain-segment drop "done" print ; MAIN: terrain-generation-benchmark