From 1e595fcad03687c72338eaa7c02d70b0ab0cfb15 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 31 Jul 2022 09:27:46 -0700 Subject: [PATCH] tools.disassembler: make udis86 pprint words so we can click on them. --- basis/tools/disassembler/disassembler.factor | 15 ++--- basis/tools/disassembler/gdb/gdb.factor | 8 ++- basis/tools/disassembler/udis/udis.factor | 63 ++++++++++++-------- basis/tools/disassembler/utils/utils.factor | 20 ------- 4 files changed, 51 insertions(+), 55 deletions(-) delete mode 100644 basis/tools/disassembler/utils/utils.factor diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor index 0f864ff874..c7ac14d8c3 100644 --- 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 62406d272e..72a75983d4 100644 --- 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 +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 f7565edc7c..1b3fda5e91 100644 --- 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 + ] [ 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 index c3bb28d3a1..0000000000 --- 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* ; -- 2.34.1