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
<<
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 ;
--- /dev/null
+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