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' b96e9278eb 2011-04-06 crc: : decompile ( a-a ) [ ^dissect'decompile ] sip "%d %s\n" puts ; 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 b1f910be0c 2010-11-14 charlesch: b1f910be0c 2010-11-14 charlesch: {{ 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--- abfd99870e 2011-01-19 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 ; abfd99870e 2011-01-19 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: }} abfd99870e 2011-01-19 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 ; b1f910be0c 2010-11-14 charlesch: 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 ; 4788ae3ab1 2011-04-02 charlesch: ---reveal--- 7326d0b4e8 2011-04-02 charlesch: : :see ( a- ) 7326d0b4e8 2011-04-02 charlesch: cr @vertical 4788ae3ab1 2011-04-02 charlesch: [ [ decompile dup 1- ^dissect'endOfWord? not ] while drop ] &.thread if ; 7326d0b4e8 2011-04-02 charlesch: : see ( "- ) getAddress :see ; 4788ae3ab1 2011-04-02 charlesch: : explore ( "- ) getAddress !x more? on browse ; 4788ae3ab1 2011-04-02 charlesch: }} 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: ( Single Step Debugger ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) 05fa66f4a8 2011-04-24 charlesch: {{ 05fa66f4a8 2011-04-24 charlesch: variable buffer 05fa66f4a8 2011-04-24 charlesch: variable ptr 05fa66f4a8 2011-04-24 charlesch: : terminate ( - ) 0 @ptr ! ; 05fa66f4a8 2011-04-24 charlesch: : start ( -a ) @buffer ; 05fa66f4a8 2011-04-24 charlesch: : end ( -a ) @ptr ; 05fa66f4a8 2011-04-24 charlesch: : add ( c- ) end ! ptr ++ terminate ; 05fa66f4a8 2011-04-24 charlesch: : get ( -c ) ptr -- end @ terminate ; 05fa66f4a8 2011-04-24 charlesch: : empty ( - ) start !ptr terminate ; 05fa66f4a8 2011-04-24 charlesch: : size ( -n ) end start - ; 05fa66f4a8 2011-04-24 charlesch: : set ( a- ) !buffer empty ; 05fa66f4a8 2011-04-24 charlesch: e82121a214 2011-05-02 crc: : image here 16 1025 * + ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: variable ip 05fa66f4a8 2011-04-24 charlesch: create port 13 allot 05fa66f4a8 2011-04-24 charlesch: create handler 13 allot 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: create rs 05fa66f4a8 2011-04-24 charlesch: 1024 allot 05fa66f4a8 2011-04-24 charlesch: rs set 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: variable fid 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : readByte ( -n ) 05fa66f4a8 2011-04-24 charlesch: @fid ^files'read ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : readCell ( -n ) 05fa66f4a8 2011-04-24 charlesch: readByte 05fa66f4a8 2011-04-24 charlesch: readByte 8 << + 05fa66f4a8 2011-04-24 charlesch: readByte 16 << + 05fa66f4a8 2011-04-24 charlesch: readByte 24 << + ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : loadImage ( $- ) 05fa66f4a8 2011-04-24 charlesch: ^files':R ^files'open !fid 05fa66f4a8 2011-04-24 charlesch: image @fid ^files'size 4 / [ readCell swap !+ ] times drop 05fa66f4a8 2011-04-24 charlesch: @fid ^files'close drop ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : writeByte ( n- ) 05fa66f4a8 2011-04-24 charlesch: @fid ^files'write drop ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : applyMask ( n- ) 05fa66f4a8 2011-04-24 charlesch: %00000000000000000000000011111111 and ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : writeCell ( n- ) 05fa66f4a8 2011-04-24 charlesch: dup applyMask writeByte 05fa66f4a8 2011-04-24 charlesch: 8 >> dup applyMask writeByte 05fa66f4a8 2011-04-24 charlesch: 8 >> dup applyMask writeByte 05fa66f4a8 2011-04-24 charlesch: 8 >> applyMask writeByte ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : saveImage ( $- ) 05fa66f4a8 2011-04-24 charlesch: ^files':W ^files'open !fid 05fa66f4a8 2011-04-24 charlesch: image image 3 + @ [ @+ writeCell ] times drop 05fa66f4a8 2011-04-24 charlesch: @fid ^files'close drop ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : ip++ ` 1 ` ip ` +! ; immediate 05fa66f4a8 2011-04-24 charlesch: : rs> get ; 05fa66f4a8 2011-04-24 charlesch: : >rs add ; 05fa66f4a8 2011-04-24 charlesch: : >image image + ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : register: ( p"- ) ' swap handler + ! ; 05fa66f4a8 2011-04-24 charlesch: : (ready) 1 !port ; 05fa66f4a8 2011-04-24 charlesch: : >port port + ; 05fa66f4a8 2011-04-24 charlesch: : port? 0 12 1+ within ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : port[ ` >port ` dup ` push ` @ ; immediate 05fa66f4a8 2011-04-24 charlesch: : ]port ` pop ` ! ` (ready) ; immediate 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : reader getc ; 05fa66f4a8 2011-04-24 charlesch: : input port[ 1 = [ reader ] [ 0 ] if ]port ; 05fa66f4a8 2011-04-24 charlesch: 1 register: input 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : output port[ 1 = [ putc ] ifTrue 0 ]port ; 05fa66f4a8 2011-04-24 charlesch: 2 register: output 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : files 05fa66f4a8 2011-04-24 charlesch: [ -1 = ] [ drop [ >image ] dip ^files'open ] when 05fa66f4a8 2011-04-24 charlesch: [ -2 = ] [ drop ^files'read ] when 05fa66f4a8 2011-04-24 charlesch: [ -3 = ] [ drop ^files'write ] when 05fa66f4a8 2011-04-24 charlesch: [ -4 = ] [ drop ^files'close ] when 05fa66f4a8 2011-04-24 charlesch: [ -5 = ] [ drop ^files'pos ] when 05fa66f4a8 2011-04-24 charlesch: [ -6 = ] [ drop ^files'seek ] when 05fa66f4a8 2011-04-24 charlesch: [ -7 = ] [ drop ^files'size ] when 05fa66f4a8 2011-04-24 charlesch: [ -8 = ] [ drop >image ^files'delete ] when 05fa66f4a8 2011-04-24 charlesch: [ 1 = ] [ drop "retroImage" saveImage 0 ] when 05fa66f4a8 2011-04-24 charlesch: [ 2 = ] [ drop >image :include 0 ] when 05fa66f4a8 2011-04-24 charlesch: drop 0 ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : vm-files port[ files ]port ; 05fa66f4a8 2011-04-24 charlesch: 4 register: vm-files 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : query 05fa66f4a8 2011-04-24 charlesch: [ -1 = ] [ drop 32768 ] when 05fa66f4a8 2011-04-24 charlesch: [ -5 = ] [ drop depth ] when 05fa66f4a8 2011-04-24 charlesch: [ -6 = ] [ drop size ] when 05fa66f4a8 2011-04-24 charlesch: [ -8 = ] [ drop time ] when 05fa66f4a8 2011-04-24 charlesch: [ -9 = ] [ drop 32768 !ip 0 ] when 05fa66f4a8 2011-04-24 charlesch: [ -10 = ] [ drop &>image bi@ getEnv 0 ] when 05fa66f4a8 2011-04-24 charlesch: drop 0 ( default ) ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : vm-info port[ query ]port ; 05fa66f4a8 2011-04-24 charlesch: 5 register: vm-info 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : handle dup handler + @ dup [ 0; do ] [ 2drop ] if ; 05fa66f4a8 2011-04-24 charlesch: : ?handle dup >port @ &handle &drop if ; 05fa66f4a8 2011-04-24 charlesch: : i/o 12 [ 0; ?handle ] iterd ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : (jmp) ` ip ` @ ` >image ` @ ` 1- ` ip ` ! ; immediate 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : vm_nop ; 05fa66f4a8 2011-04-24 charlesch: : vm_lit ip++ ip @ >image @ ; 05fa66f4a8 2011-04-24 charlesch: ( Native dup, drop, swap ) 05fa66f4a8 2011-04-24 charlesch: : vm_push >rs ; 05fa66f4a8 2011-04-24 charlesch: : vm_pop rs> ; 05fa66f4a8 2011-04-24 charlesch: : vm_loop ip++ 1- dup 0 > [ (jmp) ] [ drop ] if ; 05fa66f4a8 2011-04-24 charlesch: : vm_jmp ip++ (jmp) ; 05fa66f4a8 2011-04-24 charlesch: : vm_ret rs> !ip ; 05fa66f4a8 2011-04-24 charlesch: : vm_>jmp ip++ > [ (jmp) ] ifTrue ; 05fa66f4a8 2011-04-24 charlesch: : vm_<jmp ip++ < [ (jmp) ] ifTrue ; 05fa66f4a8 2011-04-24 charlesch: : vm_<>jmp ip++ <> [ (jmp) ] ifTrue ; 05fa66f4a8 2011-04-24 charlesch: : vm_=jmp ip++ = [ (jmp) ] ifTrue ; 05fa66f4a8 2011-04-24 charlesch: : vm_@ >image @ ; 05fa66f4a8 2011-04-24 charlesch: : vm_! >image ! ; 05fa66f4a8 2011-04-24 charlesch: ( Native +, -, *, /mod, and, or, xor, shl , shr ) 05fa66f4a8 2011-04-24 charlesch: : vm_0exit dup 0 = [ drop rs> ip ! ] ifTrue ; 05fa66f4a8 2011-04-24 charlesch: ( Native inc [1+], dec [1-] ) 05fa66f4a8 2011-04-24 charlesch: : vm_in >port dup [ @ 0 ] dip ! ; 05fa66f4a8 2011-04-24 charlesch: : vm_out dup port? [ >port ! ] [ 2drop ] if ; 05fa66f4a8 2011-04-24 charlesch: : vm_wait port @ 1 <> &i/o ifTrue ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: create opcodes 05fa66f4a8 2011-04-24 charlesch: &vm_nop , &vm_lit , &dup , 05fa66f4a8 2011-04-24 charlesch: &drop , &swap , &vm_push , 05fa66f4a8 2011-04-24 charlesch: &vm_pop , &vm_loop , &vm_jmp , 05fa66f4a8 2011-04-24 charlesch: &vm_ret , &vm_>jmp , &vm_<jmp , 05fa66f4a8 2011-04-24 charlesch: &vm_<>jmp , &vm_=jmp , &vm_@ , 05fa66f4a8 2011-04-24 charlesch: &vm_! , &+ , &- , 05fa66f4a8 2011-04-24 charlesch: &* , &/mod , &and , 05fa66f4a8 2011-04-24 charlesch: &or , &xor , &<< , 05fa66f4a8 2011-04-24 charlesch: &>> , &vm_0exit , &1+ , 05fa66f4a8 2011-04-24 charlesch: &1- , &vm_in , &vm_out , 05fa66f4a8 2011-04-24 charlesch: &vm_wait , 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : process 05fa66f4a8 2011-04-24 charlesch: @ip >image @ dup 0 30 within 05fa66f4a8 2011-04-24 charlesch: [ opcodes + @ do ] 05fa66f4a8 2011-04-24 charlesch: [ @ip >rs 1- !ip ] if ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : --- ( - ) 05fa66f4a8 2011-04-24 charlesch: 24 [ '- putc ] times cr ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : displayRegisters ( - ) cebe086906 2011-05-02 crc: depth size @ip "IP: %d RSP: %d SP: %d" puts .s cr ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : displayInstruction ( - ) 05fa66f4a8 2011-04-24 charlesch: @ip decompile drop ; cebe086906 2011-05-02 crc: e82121a214 2011-05-02 crc: variable (steps) 05fa66f4a8 2011-04-24 charlesch: ---reveal--- 05fa66f4a8 2011-04-24 charlesch: : step ( - ) cebe086906 2011-05-02 crc: (steps) ++ 05fa66f4a8 2011-04-24 charlesch: size 0 >= 0; drop e82121a214 2011-05-02 crc: cr --- displayRegisters displayInstruction --- 05fa66f4a8 2011-04-24 charlesch: process ip ++ ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : steps ( n- ) 05fa66f4a8 2011-04-24 charlesch: &step times ; 05fa66f4a8 2011-04-24 charlesch: 05fa66f4a8 2011-04-24 charlesch: : debug: ( "- ) e82121a214 2011-05-02 crc: 0 image here 1+ copy e82121a214 2011-05-02 crc: empty 0 !(steps) ' !ip ; cebe086906 2011-05-02 crc: cebe086906 2011-05-02 crc: : finished ( - ) cebe086906 2011-05-02 crc: @(steps) "\nTotal instructions processed: %d\n" puts ; 05fa66f4a8 2011-04-24 charlesch: }} 68b29dbc2e 2011-04-29 crc: 68b29dbc2e 2011-04-29 crc: : runtime ( q- ) 68b29dbc2e 2011-04-29 crc: time [ do ] dip time swap - "\nExecution took %d seconds.\n" puts ; 792d0c7a11 2010-11-13 crc: ;chain 792d0c7a11 2010-11-13 crc: 792d0c7a11 2010-11-13 crc: global with autopsy'