Artifact bb1d75c4ad696d4461ca7bae7e7f69b76dd0d1c4
File user/crc/unwell/unwell.rx part of check-in [cf0bb1439f] - add unwell by crc on 2011-07-28 17:02:17. [annotate]
( unwell - web based debugger for Retro )
( copyright [c] 2011, Charles Childers )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Some notes on this: )
( - it is *not* a replacement for Autopsy )
( - as with most of the things I develop, this is primarily for my personal )
( use )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
needs casket'
needs dissect'
with casket'
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Custom decompiler. The standard autopsy debugger doesn't output HTML, so we )
( create our own here. )
( )
( Of interest here is buildString, which builds a string from tokens returned )
( by a quote. This is useful in various contexts, not limited to this code. )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{{
variable this
variable str
: asc " ' ' " ;
: pad ( $n-$ ) [ 32 ^strings'appendChar ] times ;
: buildString ( q-$ )
depth [ do ] dip depth swap - 1- [ ^strings'append ] times ;
: following
@this @ toString this ++ ;
: padName ( $-$ )
withLength @str getLength - 24 swap - dup 0 > &pad &drop if ;
: appendName ( $-$ )
padName
@str toNumber 32 127 within
[ @str toNumber asc 2 + ! asc ^strings'append ] [ 5 pad ] if
@str toNumber xt->d dup [ d->name ^strings'append ] &drop if ;
: buildLink ( $- )
keepString !str
[ "<a href='" casket:url "/decompile/" @str "'>" @str "</a>" ] buildString appendName ;
: instr ( n-af )
this ++ ^dissect'lookupOpcode
[ [ "call " swap buildLink ^strings'append ] dip ] ifFalse ;
---reveal---
: decompile ( a-a$ )
dup !this @ instr [ following buildLink ^strings'append ] ifTrue @this swap ;
: display
[ &decompile sip "<tr><td><tt>%d</tt></td><td><tt>%s</tt></td>\n" puts
dup 1- ^dissect'endOfWord? not ] while drop ;
}}
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Simplify the header/footer stuff a bit. This will change when I finish the )
( combinator based HTML generator. )
( )
( commonHeader .... commonFooter => [ ... ] stdTemplate )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: commonHeader ( - )
Content-type: text/html
"header.html" withTemplate ;
: commonFooter ( - )
"footer.html" withTemplate ;
: stdTemplate ( q- )
commonHeader do commonFooter ;
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( The basic views )
( )
( /css )
( This is the standard stylesheet. The default configuration is to use a )
( dark color scheme based on the Web and Android releases of Retro )
( )
( /index )
( The default view. This displays a six column table of named items in the)
( dictionary. Clicking them takes you to the /decompile view for the code )
( in question. )
( )
( /decompile/address )
( Dissassemble the code starting at address. This tries to detect the end )
( of a function by looking for the standard double VM_RET laid down by the)
( Retro compiler. Jump and call targets are hyperlinked, and both ASCII )
( and symbolic names for values are displayed. )
( )
( /examine/<code> )
( Compile and then decompile a bit of code. Useful if you suspect odd bugs)
( related to macros and the like. )
( )
( /evaluate/<code> )
( Compile and run a bit of code. This is *unsafe* and will be removed or )
( sandboxed later )
( )
( /trace/<code> )
( Compile and run a bit of code in a sandboxed environment. Displays the )
( results of the run, instruction by instruction. This is roughly the same)
( as *steps* in Autopsy. )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
serve: css as text/css
: /decompile
commonHeader
casket:options toNumber xt->d dup [ d->name "<p>Showing decompiled code for <b>%s</b></p>" puts ] [ drop ] if
"<div id='output'><table width='600px'>
<tr>
<td width='25%%' style='border-bottom: 1px solid #ccc'><tt>address</tt></td>
<td width='75%%' style='border-bottom: 1px solid #ccc'><tt>ngaro assembly</tt></td>
</tr>" puts
casket:options toNumber display
"</table></div>" puts
commonFooter ;
{{
2 elements buffer count
: restore ( - ) &getc :devector ok ;
: get ( -c ) @buffer @ ;
: next ( -c ) @count [ count -- get buffer ++ ] [ 32 restore ] if ;
: replace ( - ) &next &getc :is ;
: word ( d- ) dup @d->xt swap @d->class withClass ;
: build# ( - ) tib toNumber .data ;
: number ( - ) tib isNumber? [ build# ] [ notFound ] if ;
: process ( af- ) [ word ] [ drop number ] if ;
: dump
"<div id='output'><table width='600px'>
<tr>
<td width='25%%' style='border-bottom: 1px solid #ccc'><tt>address</tt></td>
<td width='75%%' style='border-bottom: 1px solid #ccc'><tt>ngaro assembly</tt></td>
</tr>" puts
display
"</table></div>" puts ;
---reveal---
: eval ( an- ) dup 0 > [ !count !buffer replace ] [ 2drop ] if ;
: listen ( - ) repeat ok 32 accept tib find process &getc @ 0; drop again ;
: /eval
commonHeader
"eval.erx" withTemplate
"<pre>" puts
casket:options dup 1 > [ withLength eval listen ] [ drop ] if
"</pre>" puts
commonFooter ;
: /examine
commonHeader
"examine.erx" withTemplate
"<pre>" puts
casket:options dup 1 > [ "here ]] " ^strings'prepend " ;" ^strings'append withLength eval listen dump ] [ drop ] if
"</pre>" puts
commonFooter ;
}}
{{
variable count
---reveal---
: /index
commonHeader
here build "<p>Image Build ID: %s<br>Memory Used: %d cells</p>" puts
"<p>The following functions are defined in this image:</p>" tputs
0 !count
"<div id='output'><table width='800px'>\n<tr>" puts
last [ dup d->name swap @d->xt "<td><tt><a href='%u/decompile/%d'>%S</a></tt></td>" tputs
count ++ @count 6 > [ 0 !count "</tr>\n<tr>" puts ] ifTrue ] ^types'LIST each@
@count [ "<td></td>" puts ] times "</tr>\n" puts
"</table></div>" puts
commonFooter ;
}}
[ /index ] is /
include autopsy.rx
hide eval hide listen hide stdTemplate hide commonFooter hide commonHeader hide display hide decompile
[ ( -$ ) "/path/to/unwell/" ] is casket:root
[ ( -$ ) "http://url/for/unwell" ] is casket:url
&dispatch is boot
.s save bye