abfd99870e 2011-01-19 crc: ( Autopsy ------------------------------------------------------------------- ) abfd99870e 2011-01-19 crc: ( Copyright [c] 2010 - 2011, Charles Childers ) abfd99870e 2011-01-19 crc: ( Copyright [c] 2011, Marc Simpson ) 343e9dce3a 2011-04-02 charlesch: ( License: ISC ) abfd99870e 2011-01-19 crc: ( --------------------------------------------------------------------------- ) abfd99870e 2011-01-19 crc: needs dissect' 792d0c7a11 2010-11-13 crc: 792d0c7a11 2010-11-13 crc: chain: autopsy' 88f90a2358 2011-03-30 crc: : decompile ( a-a ) dup ^dissect'decompile swap "%d %s\n" puts 1+ ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: ( --[ Box Drawing Code ]----------------------------------------------------- ) abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: ( --[ Box geometry ]------------------------------------------ ) abfd99870e 2011-01-19 crc: 16 variable: boxWidth abfd99870e 2011-01-19 crc: 4 variable: boxMargin abfd99870e 2011-01-19 crc: 4 variable: box/line 792d0c7a11 2010-11-13 crc: 792d0c7a11 2010-11-13 crc: {{ abfd99870e 2011-01-19 crc: ( --[ Core ]------------------------------------------------ ) abfd99870e 2011-01-19 crc: 343e9dce3a 2011-04-02 charlesch: : putcs ( cn- ) [ dup putc ] times drop ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: : padCount ( n-n ) @boxWidth @boxMargin - swap - ; abfd99870e 2011-01-19 crc: : .pad ( n-n ) padCount 32 swap putcs ; abfd99870e 2011-01-19 crc: : .pads ( $- ) withLength swap puts .pad ; abfd99870e 2011-01-19 crc: : .number ( n- ) toString .pads ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: : .boxedn ( n- ) '| putc space .number space '| putc ; abfd99870e 2011-01-19 crc: : .empty ( - ) '| putc -2 .pad '| putc ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: : xt->name ( $-$ ) toNumber xt->d dup [ d->name ] [ drop "" ] if ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: variable escCell abfd99870e 2011-01-19 crc: : lookup ( a-$ ) abfd99870e 2011-01-19 crc: @escCell abfd99870e 2011-01-19 crc: [ toString escCell off ] abfd99870e 2011-01-19 crc: [ ^dissect'lookupOpcode [ [ escCell on ] ifTrue ] [ drop xt->name ] if ] if ; abfd99870e 2011-01-19 crc: : .lookup ( a- ) '| putc space lookup .pads space '| putc ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: : .fill ( c- ) @boxWidth @boxMargin 2 - - putcs ; abfd99870e 2011-01-19 crc: : .edge ( - ) '+ putc '- .fill '+ putc ; abfd99870e 2011-01-19 crc: : .rule ( - ) '| putc '- .fill '| putc ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: ( --[ Diagram for N contiguous cells ]---------------------- ) abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: 6 constant boxRows create boxtbl boxRows allot abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: boxtbl variable: currentRow abfd99870e 2011-01-19 crc: : boxRow, @currentRow ! currentRow ++ ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: [ ( a- ) .edge drop ; ] boxRow, abfd99870e 2011-01-19 crc: [ ( a- ) .boxedn ; ] boxRow, abfd99870e 2011-01-19 crc: [ ( a- ) .rule drop ; ] boxRow, abfd99870e 2011-01-19 crc: [ ( a- ) @ .boxedn ; ] boxRow, abfd99870e 2011-01-19 crc: [ ( a- ) @ .lookup ; ] boxRow, abfd99870e 2011-01-19 crc: [ ( a- ) .edge drop ; ] boxRow, abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: : (.row) ( aqn-aqn ) abfd99870e 2011-01-19 crc: repeat dup 0 = if; abfd99870e 2011-01-19 crc: [ over 1+ [ tuck do ] dip swap ] dip 1- again ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: : .row ( aqn- ) cr (.row) 2drop drop ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: : (.cells) ( an- ) abfd99870e 2011-01-19 crc: 0 repeat dup boxRows = if; dup 1+ d254cde5a2 2011-02-12 crc: [ ( ann ) boxtbl + @ ( anq ) [ 2over ] dip swap .row ( an ) ] dip again ; abfd99870e 2011-01-19 crc: abfd99870e 2011-01-19 crc: ( --[ Utility words for finding the RET opcode ]------------ ) abfd99870e 2011-01-19 crc: 343e9dce3a 2011-04-02 charlesch: : findRet ( a-na ) 1 swap repeat dup ^dissect'endOfWord? if; &1+ bi@ again ; abfd99870e 2011-01-19 crc: ---reveal--- 14497043a4 2010-11-13 crc: abfd99870e 2011-01-19 crc: : .cells ( an- ) abfd99870e 2011-01-19 crc: dup @box/line > abfd99870e 2011-01-19 crc: [ @box/line - [ @box/line (.cells) drop + ] dip .cells ] abfd99870e 2011-01-19 crc: [ (.cells) 2drop drop ] if ; 14497043a4 2010-11-13 crc: abfd99870e 2011-01-19 crc: : .cell ( a- ) 1 .cells ; abfd99870e 2011-01-19 crc: : .thread ( a- ) dup findRet drop .cells ; abfd99870e 2011-01-19 crc: }} 792d0c7a11 2010-11-13 crc: 4788ae3ab1 2011-04-02 charlesch: ( --[ "see" and "explore" ]-------------------------------------------------- ) 4788ae3ab1 2011-04-02 charlesch: variable vertical abfd99870e 2011-01-19 crc: {{ b1f910be0c 2010-11-14 charlesch: : help ( - ) b1f910be0c 2010-11-14 charlesch: clear b1f910be0c 2010-11-14 charlesch: "Autposy is a tool for exploring images interactively.\n\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "| i | Backtrack display by one address |\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "| j | Backtrack display by one screen |\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "| k | Advance display by one address |\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "| l | Advance display by one screen |\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "| z | Quit Autospy |\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "| ? | Display this help screen |\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "| 1 | Jump to address |\n" puts b1f910be0c 2010-11-14 charlesch: "+---+----------------------------------+\n" puts b1f910be0c 2010-11-14 charlesch: "\nPress any key to return to autospy.\n" puts 82c2a445c5 2011-01-17 charlesch: getc drop ; 792d0c7a11 2010-11-13 crc: 14497043a4 2010-11-13 crc: 2 elements x more? b1f910be0c 2010-11-14 charlesch: 4788ae3ab1 2011-04-02 charlesch: : goToAddress ( "- ) b1f910be0c 2010-11-14 charlesch: clear "Address to jump to: " puts getToken toNumber !x ; 82c2a445c5 2011-01-17 charlesch: : rows @ch 2 - ; 82c2a445c5 2011-01-17 charlesch: : cols @cw 1 - ; 792d0c7a11 2010-11-13 crc: : handle abfd99870e 2011-01-19 crc: cols [ '- putc ] times cr 82c2a445c5 2011-01-17 charlesch: getc 4788ae3ab1 2011-04-02 charlesch: [ 'i = ] [ drop x -- ] when 4788ae3ab1 2011-04-02 charlesch: [ 'k = ] [ drop x ++ ] when 4788ae3ab1 2011-04-02 charlesch: [ 'j = ] [ drop rows -x ] when 4788ae3ab1 2011-04-02 charlesch: [ 'l = ] [ drop rows +x ] when 4788ae3ab1 2011-04-02 charlesch: [ '? = ] [ drop help ] when 4788ae3ab1 2011-04-02 charlesch: [ '1 = ] [ drop goToAddress ] when 4788ae3ab1 2011-04-02 charlesch: [ 'z = ] [ drop more? off ] when 792d0c7a11 2010-11-13 crc: drop ; 4788ae3ab1 2011-04-02 charlesch: : browse ( - ) 4788ae3ab1 2011-04-02 charlesch: [ clear @x rows &decompile times drop handle @more? ] while ; 4788ae3ab1 2011-04-02 charlesch: : getAddress ( "- ) 4788ae3ab1 2011-04-02 charlesch: getToken dup find [ nip @d->xt ] [ drop toNumber ] if ; 792d0c7a11 2010-11-13 crc: ---reveal--- 4788ae3ab1 2011-04-02 charlesch: : see ( "- ) 4788ae3ab1 2011-04-02 charlesch: getAddress cr @vertical 4788ae3ab1 2011-04-02 charlesch: [ [ decompile dup 1- ^dissect'endOfWord? not ] while drop ] &.thread if ; 4788ae3ab1 2011-04-02 charlesch: : explore ( "- ) getAddress !x more? on browse ; 792d0c7a11 2010-11-13 crc: }} 792d0c7a11 2010-11-13 crc: ;chain 792d0c7a11 2010-11-13 crc: 792d0c7a11 2010-11-13 crc: global with autopsy'