tools.disassembler: make udis86 pprint words so we can click on them.

diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor
index 0f864ff8740194a70e3fa27b4851c1db6500944e..c7ac14d8c36da6078e6af31870c4d138d71b7a79 100644 (file)
--- a/basis/tools/disassembler/disassembler.factor
+++ b/basis/tools/disassembler/disassembler.factor
@@ -11,27 +11,24 @@ GENERIC: disassemble ( obj -- )
 
 SYMBOL: disassembler-backend
 
-HOOK: disassemble* disassembler-backend ( from to -- lines )
+HOOK: disassemble* disassembler-backend ( from to -- )
 
-TR: tabs>spaces "\t" "\s" ;
+GENERIC: convert-address ( object -- n )
 
-GENERIC: (>address) ( object -- n )
+M: integer convert-address ;
 
-M: integer (>address) ;
-M: alien (>address) alien-address ;
+M: alien convert-address alien-address ;
 
 PRIVATE>
 
 M: byte-array disassemble
     [
         [ malloc-byte-array &free alien-address dup ]
-        [ length + ] bi
-        2array disassemble
+        [ length + ] bi 2array disassemble
     ] with-destructors ;
 
 M: pair disassemble
-    first2-unsafe [ (>address) ] bi@ disassemble*
-    [ tabs>spaces print ] each ;
+    first2-unsafe [ convert-address ] bi@ disassemble* ;
 
 M: word disassemble word-code 2array disassemble ;
 

diff --git a/basis/tools/disassembler/gdb/gdb.factor b/basis/tools/disassembler/gdb/gdb.factor
index 62406d272e83b4e90a8fa422197a08fa488eaa8f..72a75983d4e8b0de16c02fec5b94da11a5f57d42 100644 (file)
--- a/basis/tools/disassembler/gdb/gdb.factor
+++ b/basis/tools/disassembler/gdb/gdb.factor
@@ -7,6 +7,10 @@ IN: tools.disassembler.gdb
 
 SINGLETON: gdb-disassembler
 
+<PRIVATE
+
+TR: tabs>spaces "\t" "\s" ;
+
 : in-file ( -- path ) "gdb-in.txt" temp-file ;
 
 : out-file ( -- path ) "gdb-out.txt" temp-file ;
@@ -27,7 +31,9 @@ SINGLETON: gdb-disassembler
     try-process
     out-file ascii file-lines ;
 
+PRIVATE>
+
 M: gdb-disassembler disassemble*
-    make-disassemble-cmd run-gdb ;
+    make-disassemble-cmd run-gdb [ tabs>spaces print ] each ;
 
 gdb-disassembler disassembler-backend set-global

diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor
index f7565edc7cba43859f1befe946f3edac329f17e4..1b3fda5e91f0785dee1955bf572fd9aab0fe5fad 100644 (file)
--- a/basis/tools/disassembler/udis/udis.factor
+++ b/basis/tools/disassembler/udis/udis.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Jorge Acereda Macia.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.libraries alien.syntax arrays
-combinators destructors kernel layouts libc make math
-math.order math.parser namespaces sequences splitting system
-tools.disassembler.private tools.disassembler.utils tools.memory ;
+USING: accessors alien alien.c-types alien.libraries
+alien.syntax arrays combinators destructors io kernel
+layouts libc make math math.order math.parser namespaces
+prettyprint sequences splitting system
+tools.disassembler.private tools.memory ;
 IN: tools.disassembler.udis
 
 << "libudis86" {
@@ -55,41 +56,53 @@ FUNCTION: c-string ud_lookup_mnemonic ( int c )
 
 SINGLETON: udis-disassembler
 
+<PRIVATE
+
 : buf/len ( from to -- buf len ) [ drop <alien> ] [ swap - ] 2bi ;
 
-: resolve-call ( str -- str' ) "0x" split1-last [ resolve-xt append ] when* ;
+: complete-address ( n seq -- )
+    " (" % building get [ "" like write ] [ delete-all ] bi
+    [ nip owner>> pprint-short ] [ entry-point>> - ] 2bi
+    [ " + 0x" % >hex % ] unless-zero ")" % ;
 
-: format-disassembly ( lines -- lines' )
-    dup [ second length ] [ max ] map-reduce
-    '[
-        [
+: search-xt ( addr -- )
+    dup lookup-return-address [ complete-address ] [ drop ] if* ;
+
+: resolve-xt ( str -- )
+    string>number [ search-xt ] when* ;
+
+: resolve-call ( str -- )
+    "0x" over subseq-start [ tail-slice resolve-xt ] [ drop ] if* ;
+
+: write-disassembly ( lines -- )
+    dup [ second length ] [ max ] map-reduce [
+        '[
             [ first >hex cell 2 * CHAR: 0 pad-head % ": " % ]
             [ second _ CHAR: \s pad-tail % "  " % ]
-            [ third resolve-call % ]
-            tri
-        ] "" make
-    ] map ;
+            [ third [ % ] [ resolve-call ] bi ]
+            tri CHAR: \n ,
+        ] each
+    ] "" make write ;
 
-: (disassemble) ( ud -- lines )
+: make-disassembly ( ud -- lines )
     [
-        dup '[
-            _ ud_disassemble 0 =
-            [ f ] [
-                _
-                [ ud_insn_off ]
-                [ ud_insn_hex ]
-                [ ud_insn_asm ]
-                tri 3array , t
-            ] if
-        ] loop
+        [ dup ud_disassemble 0 = ] [
+            dup
+            [ ud_insn_off ]
+            [ ud_insn_hex ]
+            [ ud_insn_asm ]
+            tri 3array ,
+        ] until drop
     ] { } make ;
 
+PRIVATE>
+
 M: udis-disassembler disassemble*
     '[
         _ _
         [ drop ud_set_pc ]
         [ buf/len ud_set_input_buffer ]
-        [ 2drop (disassemble) format-disassembly ]
+        [ 2drop make-disassembly write-disassembly ]
         3tri
     ] with-ud ;
 

diff --git a/basis/tools/disassembler/utils/utils.factor b/basis/tools/disassembler/utils/utils.factor
deleted file mode 100644 (file)
index c3bb28d..0000000
--- a/basis/tools/disassembler/utils/utils.factor
+++ /dev/null
@@ -1,20 +0,0 @@
-USING: accessors kernel math math.parser prettyprint sequences
-splitting tools.memory ;
-IN: tools.disassembler.utils
-
-: 0x- ( str -- str' ) "0x" prepend ;
-
-: complete-address ( n seq -- str )
-    [ nip owner>> unparse-short ] [ entry-point>> - ] 2bi
-    [ >hex 0x- " + " glue ] unless-zero ;
-
-: search-xt ( addr -- str/f )
-    dup lookup-return-address
-    dup [ complete-address ] [ 2drop f ] if ;
-
-: resolve-xt ( str -- str' )
-    [ 0x- ] [ hex> ] bi
-    [ search-xt [ " (" ")" surround append ] when* ] when* ;
-
-: resolve-call ( str -- str' )
-    "0x" split1-last [ resolve-xt "0x" glue ] when* ;