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