Artifact 607d53df9b4dbb4e72c3824b0858078e5bb2d50d
File autopsy.rx part of check-in [dae5014a2f] - autopsy: some comments on interactive memory explorer by crc on 2011-05-02 17:58:41. [annotate]
( Autopsy ------------------------------------------------------------------- )
( Copyright [c] 2010 - 2011, Charles Childers )
( Copyright [c] 2011, Marc Simpson )
( License: ISC )
( --------------------------------------------------------------------------- )
needs dissect'
chain: autopsy'
: decompile ( a-a ) [ ^dissect'decompile ] sip "%d %s\n" puts ;
( --[ Box Drawing Code ]----------------------------------------------------- )
( --[ Box geometry ]------------------------------------------ )
16 variable: boxWidth
4 variable: boxMargin
4 variable: box/line
{{
( --[ Core ]------------------------------------------------ )
: putcs ( cn- ) [ dup putc ] times drop ;
: padCount ( n-n ) @boxWidth @boxMargin - swap - ;
: .pad ( n-n ) padCount 32 swap putcs ;
: .pads ( $- ) withLength swap puts .pad ;
: .number ( n- ) toString .pads ;
: .boxedn ( n- ) '| putc space .number space '| putc ;
: .empty ( - ) '| putc -2 .pad '| putc ;
: xt->name ( $-$ ) toNumber xt->d dup [ d->name ] [ drop "" ] if ;
variable escCell
: lookup ( a-$ )
@escCell
[ toString escCell off ]
[ ^dissect'lookupOpcode [ [ escCell on ] ifTrue ] [ drop xt->name ] if ] if ;
: .lookup ( a- ) '| putc space lookup .pads space '| putc ;
: .fill ( c- ) @boxWidth @boxMargin 2 - - putcs ;
: .edge ( - ) '+ putc '- .fill '+ putc ;
: .rule ( - ) '| putc '- .fill '| putc ;
( --[ Diagram for N contiguous cells ]---------------------- )
6 constant boxRows create boxtbl boxRows allot
boxtbl variable: currentRow
: boxRow, @currentRow ! currentRow ++ ;
[ ( a- ) .edge drop ; ] boxRow,
[ ( a- ) .boxedn ; ] boxRow,
[ ( a- ) .rule drop ; ] boxRow,
[ ( a- ) @ .boxedn ; ] boxRow,
[ ( a- ) @ .lookup ; ] boxRow,
[ ( a- ) .edge drop ; ] boxRow,
: (.row) ( aqn-aqn )
repeat dup 0 = if;
[ over 1+ [ tuck do ] dip swap ] dip 1- again ;
: .row ( aqn- ) cr (.row) 2drop drop ;
: (.cells) ( an- )
0 repeat dup boxRows = if; dup 1+
[ ( ann ) boxtbl + @ ( anq ) [ 2over ] dip swap .row ( an ) ] dip again ;
( --[ Utility words for finding the RET opcode ]------------ )
: findRet ( a-na ) 1 swap repeat dup ^dissect'endOfWord? if; &1+ bi@ again ;
---reveal---
: .cells ( an- )
dup @box/line >
[ @box/line - [ @box/line (.cells) drop + ] dip .cells ]
[ (.cells) 2drop drop ] if ;
: .cell ( a- ) 1 .cells ;
: .thread ( a- ) dup findRet drop .cells ;
}}
( --[ "see" and "explore" ]-------------------------------------------------- )
variable vertical
{{
: help ( - )
clear
"Autposy is a tool for exploring images interactively.\n\n" puts
"+---+----------------------------------+\n" puts
"| i | Backtrack display by one address |\n" puts
"+---+----------------------------------+\n" puts
"| j | Backtrack display by one screen |\n" puts
"+---+----------------------------------+\n" puts
"| k | Advance display by one address |\n" puts
"+---+----------------------------------+\n" puts
"| l | Advance display by one screen |\n" puts
"+---+----------------------------------+\n" puts
"| z | Quit Autospy |\n" puts
"+---+----------------------------------+\n" puts
"| ? | Display this help screen |\n" puts
"+---+----------------------------------+\n" puts
"| 1 | Jump to address |\n" puts
"+---+----------------------------------+\n" puts
"\nPress any key to return to autospy.\n" puts
getc drop ;
2 elements x more?
: goToAddress ( "- )
clear "Address to jump to: " puts getToken toNumber !x ;
: rows @ch 2 - ;
: cols @cw 1 - ;
: handle
cols [ '- putc ] times cr
getc
[ 'i = ] [ drop x -- ] when
[ 'k = ] [ drop x ++ ] when
[ 'j = ] [ drop rows -x ] when
[ 'l = ] [ drop rows +x ] when
[ '? = ] [ drop help ] when
[ '1 = ] [ drop goToAddress ] when
[ 'z = ] [ drop more? off ] when
drop ;
: browse ( - )
[ clear @x rows &decompile times drop handle @more? ] while ;
: getAddress ( "- )
getToken dup find [ nip @d->xt ] [ drop toNumber ] if ;
---reveal---
: :see ( a- )
cr @vertical
[ [ decompile dup 1- ^dissect'endOfWord? not ] while drop ] &.thread if ;
: see ( "- ) getAddress :see ;
: explore ( "- ) getAddress !x more? on browse ;
}}
( Single Step Debugger ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{{
variable buffer
variable ptr
: terminate ( - ) 0 @ptr ! ;
: start ( -a ) @buffer ;
: end ( -a ) @ptr ;
: add ( c- ) end ! ptr ++ terminate ;
: get ( -c ) ptr -- end @ terminate ;
: empty ( - ) start !ptr terminate ;
: size ( -n ) end start - ;
: set ( a- ) !buffer empty ;
: image here 16 1025 * + ;
variable ip
create port 13 allot
create handler 13 allot
create rs
1024 allot
rs set
variable fid
: readByte ( -n )
@fid ^files'read ;
: readCell ( -n )
readByte
readByte 8 << +
readByte 16 << +
readByte 24 << + ;
: loadImage ( $- )
^files':R ^files'open !fid
image @fid ^files'size 4 / [ readCell swap !+ ] times drop
@fid ^files'close drop ;
: writeByte ( n- )
@fid ^files'write drop ;
: applyMask ( n- )
%00000000000000000000000011111111 and ;
: writeCell ( n- )
dup applyMask writeByte
8 >> dup applyMask writeByte
8 >> dup applyMask writeByte
8 >> applyMask writeByte ;
: saveImage ( $- )
^files':W ^files'open !fid
image image 3 + @ [ @+ writeCell ] times drop
@fid ^files'close drop ;
: ip++ ` 1 ` ip ` +! ; immediate
: rs> get ;
: >rs add ;
: >image image + ;
: register: ( p"- ) ' swap handler + ! ;
: (ready) 1 !port ;
: >port port + ;
: port? 0 12 1+ within ;
: port[ ` >port ` dup ` push ` @ ; immediate
: ]port ` pop ` ! ` (ready) ; immediate
: reader getc ;
: input port[ 1 = [ reader ] [ 0 ] if ]port ;
1 register: input
: output port[ 1 = [ putc ] ifTrue 0 ]port ;
2 register: output
: files
[ -1 = ] [ drop [ >image ] dip ^files'open ] when
[ -2 = ] [ drop ^files'read ] when
[ -3 = ] [ drop ^files'write ] when
[ -4 = ] [ drop ^files'close ] when
[ -5 = ] [ drop ^files'pos ] when
[ -6 = ] [ drop ^files'seek ] when
[ -7 = ] [ drop ^files'size ] when
[ -8 = ] [ drop >image ^files'delete ] when
[ 1 = ] [ drop "retroImage" saveImage 0 ] when
[ 2 = ] [ drop >image :include 0 ] when
drop 0 ;
: vm-files port[ files ]port ;
4 register: vm-files
: query
[ -1 = ] [ drop 32768 ] when
[ -5 = ] [ drop depth ] when
[ -6 = ] [ drop size ] when
[ -8 = ] [ drop time ] when
[ -9 = ] [ drop 32768 !ip 0 ] when
[ -10 = ] [ drop &>image bi@ getEnv 0 ] when
drop 0 ( default ) ;
: vm-info port[ query ]port ;
5 register: vm-info
: handle dup handler + @ dup [ 0; do ] [ 2drop ] if ;
: ?handle dup >port @ &handle &drop if ;
: i/o 12 [ 0; ?handle ] iterd ;
: (jmp) ` ip ` @ ` >image ` @ ` 1- ` ip ` ! ; immediate
: vm_nop ;
: vm_lit ip++ ip @ >image @ ;
( Native dup, drop, swap )
: vm_push >rs ;
: vm_pop rs> ;
: vm_loop ip++ 1- dup 0 > [ (jmp) ] [ drop ] if ;
: vm_jmp ip++ (jmp) ;
: vm_ret rs> !ip ;
: vm_>jmp ip++ > [ (jmp) ] ifTrue ;
: vm_<jmp ip++ < [ (jmp) ] ifTrue ;
: vm_<>jmp ip++ <> [ (jmp) ] ifTrue ;
: vm_=jmp ip++ = [ (jmp) ] ifTrue ;
: vm_@ >image @ ;
: vm_! >image ! ;
( Native +, -, *, /mod, and, or, xor, shl , shr )
: vm_0exit dup 0 = [ drop rs> ip ! ] ifTrue ;
( Native inc [1+], dec [1-] )
: vm_in >port dup [ @ 0 ] dip ! ;
: vm_out dup port? [ >port ! ] [ 2drop ] if ;
: vm_wait port @ 1 <> &i/o ifTrue ;
create opcodes
&vm_nop , &vm_lit , &dup ,
&drop , &swap , &vm_push ,
&vm_pop , &vm_loop , &vm_jmp ,
&vm_ret , &vm_>jmp , &vm_<jmp ,
&vm_<>jmp , &vm_=jmp , &vm_@ ,
&vm_! , &+ , &- ,
&* , &/mod , &and ,
&or , &xor , &<< ,
&>> , &vm_0exit , &1+ ,
&1- , &vm_in , &vm_out ,
&vm_wait ,
: process
@ip >image @ dup 0 30 within
[ opcodes + @ do ]
[ @ip >rs 1- !ip ] if ;
: --- ( - )
24 [ '- putc ] times cr ;
: displayRegisters ( - )
depth size @ip "IP: %d RSP: %d SP: %d" puts .s cr ;
: displayInstruction ( - )
@ip decompile drop ;
variable (steps)
---reveal---
: step ( - )
(steps) ++
size 0 >= 0; drop
cr --- displayRegisters displayInstruction ---
process ip ++ ;
: steps ( n- )
&step times ;
: debug: ( "- )
0 image here 1+ copy
empty 0 !(steps) ' !ip ;
: finished ( - )
@(steps) "\nTotal instructions processed: %d\n" puts ;
}}
: runtime ( q- )
time [ do ] dip time swap - "\nExecution took %d seconds.\n" puts ;
;chain
global with autopsy'
doc{
=======
Autopsy
=======
--------
Overview
--------
Traditionally Retro has had only limited debugging capabilities. There's
the typical **.s** to display the stack, and various releases have provided
*see* for decompiling functions. For 11.0, we want something more powerful.
The solution is Autopsy.
-----
Tools
-----
Decompiler
==========
This allows you to examine the compiled code for a function in a readable
manner.
The decompiler has two display modes. The default, written by Marc Simpson,
displays each memory cell as a box, in a clean, very readable manner. This
is the *horizontal* mode, and is the default.
::
ok see cr
+--------------++--------------++--------------++--------------+
| 403 || 404 || 405 || 406 |
|--------------||--------------||--------------||--------------|
| 0 || 0 || 1 || 10 |
| nop || nop || lit || 10 |
+--------------++--------------++--------------++--------------+
+--------------++--------------+
| 407 || 408 |
|--------------||--------------|
| 391 || 9 |
| putc || ; |
+--------------++--------------+
There is also a *vertical* mode. In this mode, the **cr** disassembly appears
as:
::
403 nop
404 nop
405 lit 10
407 call 391
408 ;
To toggle the modes, use the **vertical** variable.
::
vertical on ( use vertical mode )
vertical off ( use horizontal mode )
Memory Explorer
===============
The memory explorer lets you examine memory interactively, starting at an
address or a specific function.
::
explore address
explore function
The key bindings are:
+-----+----------------------------------+
| Key | Usage |
+=====+==================================+
| i | Backtrack display by one address |
+-----+----------------------------------+
| j | Backtrack display by one screen |
+-----+----------------------------------+
| k | Advance display by one address |
+-----+----------------------------------+
| l | Advance display by one screen |
+-----+----------------------------------+
| z | Quit Autospy |
+-----+----------------------------------+
| ? | Display this help screen |
+-----+----------------------------------+
| 1 | Jump to address |
+-----+----------------------------------+
Single Stepper
==============
This is a new tool. It combines a virtualized Ngaro implementation and allows
watching execution progress step by step.
To allow for debugging in a sandboxed environment, the single stepper makes
a copy of the current image in memory (located at roughly 16k cells above
**here**), and provides for a private address stack. The data stack is shared
between Retro and the sandboxed image.
Exection of an instruction can be done using **step**. To execute multiple
instructions, use **steps**.
There is guard code to stop further execution when the function exits.
Output
``````
When **step** is executed, Autopsy will display the current IP, RSP, SP,
the data stack contents, and the instruction being executed. E.g.:
::
ok step
------------------------
IP: 405 RSP: 0 SP: 0
<0>
405 lit 10
------------------------
ok step
------------------------
IP: 407 RSP: 0 SP: 1
<1> 10
407 call 391
------------------------
Functions
`````````
+----------+-------+---------------------------------+
| Function | Stack | Notes |
+==========+=======+=================================+
| step | ``-`` | Execute a single instruction |
+----------+-------+---------------------------------+
| steps | n- | Execute multiple instructions |
+----------+-------+---------------------------------+
| debug: | "- | Set a function as the one to be |
| | | debugged |
+----------+-------+---------------------------------+
}doc