Differences From Artifact [d9ed214b58e4a76b]:
File autopsy.rx part of check-in [792d0c7a11] - start of work on autopsy; a tool for debugging and exploration of an image by crc on 2010-11-13 14:11:26. [annotate] [view]
To Artifact [e950cf7edd710247]:
File autopsy.rx part of check-in [14497043a4] - refactor and cleanup autopsy using quotes by crc on 2010-11-13 15:53:53. [annotate] [view]
@@ -10,10 +10,11 @@
: color.ui ^console'white ;
{{
( Helpers to make the code easier to read ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
- : case: ( nn- ) ` over ` =if ` space ; immediate
- : ;case ( nn-n ) ` swap ` puts ` nip ` ;then ; immediate
+ : case
+ [ over = ] dip swap
+ [ do swap space puts nip -1 ] [ drop 0 ] choose 0; pop 2drop ;
( Resolve addresses to headers ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: header? ( a-af ) dup xt->d ;
: .name ( a- ) xt->d d->name puts space ;
@@ -20,72 +21,76 @@
: .call ( n- ) "call " puts color.literal putn space ;
: opcode ( n- ) header? if color.name .name ;then .call ;
: (name) ( a- ) color.header '( emit space .name ') emit space ;
: resolve ( n- )
- header? color.literal if dup putn space (name) ;then putn space ;
+ color.literal header? [ dup putn space (name) ] [ putn space ] choose ;
: instr? ( n-f )
- 0 case: "nop" 0 ;case
- 1 case: "lit" -1 ;case
- 2 case: "dup" 0 ;case
- 3 case: "drop" 0 ;case
- 4 case: "swap" 0 ;case
- 5 case: "push" 0 ;case
- 6 case: "pop" 0 ;case
- 7 case: "loop" -1 ;case
- 8 case: "jump" -1 ;case
- 9 case: ";" 0 ;case
- 10 case: ">jump" -1 ;case
- 11 case: "<jump" -1 ;case
- 12 case: "!jump" -1 ;case
- 13 case: "=jump" -1 ;case
- 14 case: "@" 0 ;case
- 15 case: "!" 0 ;case
- 16 case: "+" 0 ;case
- 17 case: "-" 0 ;case
- 18 case: "*" 0 ;case
- 19 case: "/mod" 0 ;case
- 20 case: "and" 0 ;case
- 21 case: "or" 0 ;case
- 22 case: "xor" 0 ;case
- 23 case: "<<" 0 ;case
- 24 case: ">>" 0 ;case
- 25 case: "0;" 0 ;case
- 26 case: "1+" 0 ;case
- 27 case: "1-" 0 ;case
- 28 case: "in" 0 ;case
- 29 case: "out" 0 ;case
- 30 case: "wait" 0 ;case
+ 0 [ "nop" 0 ] case
+ 1 [ "lit" -1 ] case
+ 2 [ "dup" 0 ] case
+ 3 [ "drop" 0 ] case
+ 4 [ "swap" 0 ] case
+ 5 [ "push" 0 ] case
+ 6 [ "pop" 0 ] case
+ 7 [ "loop" -1 ] case
+ 8 [ "jump" -1 ] case
+ 9 [ ";" 0 ] case
+ 10 [ ">jump" -1 ] case
+ 11 [ "<jump" -1 ] case
+ 12 [ "!jump" -1 ] case
+ 13 [ "=jump" -1 ] case
+ 14 [ "@" 0 ] case
+ 15 [ "!" 0 ] case
+ 16 [ "+" 0 ] case
+ 17 [ "-" 0 ] case
+ 18 [ "*" 0 ] case
+ 19 [ "/mod" 0 ] case
+ 20 [ "and" 0 ] case
+ 21 [ "or" 0 ] case
+ 22 [ "xor" 0 ] case
+ 23 [ "<<" 0 ] case
+ 24 [ ">>" 0 ] case
+ 25 [ "0;" 0 ] case
+ 26 [ "1+" 0 ] case
+ 27 [ "1-" 0 ] case
+ 28 [ "in" 0 ] case
+ 29 [ "out" 0 ] case
+ 30 [ "wait" 0 ] case
space opcode 0 ;
+ ( See if we are at the end of a function ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
+ ( This does a few checks: )
+ ( - see if the instruction is ; )
+ ( - if so, is it followed by a header? )
+ ( - are there two seqeuntial nop instructions? )
+ ( If either condition is true, we assume the function is at an end. )
+ ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: end? ( a-a || a- )
- ( First, see if we have a ; followed by a header ~~~~~~~~~~~~~~~~~~~~~~~~ )
dup 1- @+ 9 =if @ 30 >if pop 2drop ;then ;then drop
- ( Otherwise, look for two nop's in a row ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
- dup @+ 0 =if @+ 0 =if pop 2drop else drop ;then drop ;then
- ( Neither? Discard the address ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
- drop ;
+ dup @+ 0 =if @+ 0 =if pop 2drop else drop ;then drop ;then drop ;
+
: row ( a-a )
color.normal dup putn space @+ instr? if @+ space resolve then cr ;
: decompile ( a- ) repeat row end? again ;
( Interactive browsing of memory ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
- variable x
+ 2 elements x more?
: rows @fh 2 - ;
: cols @fw 1 - ;
: handle
color.ui cols [ '- emit ] times cr
key
- 'i case: 1 -x drop ;then
- 'k case: 1 +x drop ;then
- 'j case: rows -x drop ;then
- 'l case: rows +x drop ;then
- 'z case: rdrop drop ;then
+ 'i over = [ 1 -x ] ifTrue
+ 'k over = [ 1 +x ] ifTrue
+ 'j over = [ rows -x ] ifTrue
+ 'l over = [ rows +x ] ifTrue
+ 'z over = [ more? off ] ifTrue
drop ;
- : browse ( - ) repeat clear @x rows for row next drop handle again ;
+ : browse ( - ) [ clear @x rows &row times drop handle @more? ] while ;
---reveal---
: see ( "- ) ' 0; cr decompile color.default ;
- : nav ( a- ) !x browse color.default ;
+ : nav ( a- ) !x more? on browse color.default ;
}}
;chain
global with autopsy'