Retrospect, a debugger for RetroForth                                                                                           Developed by Charles R. Childers. This is released into the     public domain.                                                                                                                  This version is a modest improvement over the original. It can  identify the exact length of most words, and recognizes a few   more code sequences properly.                                   loc:                                                              : >name dup 13 + dup 1- c@ ;                                    : match? over over cell+ @ ;                                    : clean >r >r 2drop r> r> ;                                    :: last repeat @ 0; match? =if >name clean ;; then again ;     ;loc alias resolve.name                                                                                                         n e                                                             loc:                                                             variable src     variable diff     variable done                : shift diff @ + diff ! ;          : offset diff @ ;                                                                            variable id      : found 0 id ! ;  : unknown 1 id ! ;           : found? id @ ;                                                 : read dup 1+ swap c@ ;            : h. hex # decimal ;        n e                                                              : tab 9 emit ;                                                  : comment tab '; emit space ;                                   : mcomment comment ;                                            : #comment dup 100 <if tab then comment ;                                                                                       : weAreDone 2drop 2drop 0 done ! ;                              : notDone? 2 =if 1 done ! r> drop ;; then ;                    n e                                                              loc:                                                              : setDone done @ notDone? weAreDone r> r> 2drop r> drop ;       : show type ': emit cr ;   : name= resolve.name dup ;           : .name dup name= 255 <if setDone show ;; then drop ;           : done? dup here >if setDone then ;                             : .address h. ': emit space space ;                            :: diff @ src @ + 5 - done? .name .address ;                  n e                                                              ;loc alias .addr                                                :: 1 ;  dup 1 + @ + 5 + create: (lit) literal, $c3 1,           : -offset offset + src @ + ;                                    : find.name -offset dup h. 5 shift resolve.name ;               : ## tab comment . ;                                            : .lit .addr dup @ ." dd " dup . #comment . cell+ 4 shift ;     : lit? (lit) =if mcomment ." literal" cr .lit then ;           n e                                                              : display dup 255 <if comment type ;; then lit? ;               : .name dup cell+ swap @ find.name display ;                                                                                                                                                                                                                                                                                                                                                   n e                                                              : call,  ." call "  .name ;                                     : jmp,   ." jmp  "  .name ;                                     : ret,   ." ret"    cr  1 shift ;                               : lodsd, ." lodsd" tab  mcomment ." drop"   1 shift ;           : inc,   ." inc eax"    mcomment ." 1+"     1 shift ;           : dec,   ." dec eax"    mcomment ." 1-"     1 shift ;           : stc,   ." stc"        mcomment ." false"  1 shift ;          n e                                                              : clc,   ." clc"        mcomment ." true"   1 shift ;           : push,  ." push eax"       1 shift ;                           : mov,   ." mov [esi],eax"  2 shift 1+ 1+ ;                     : pop,   ." pop eax"        6 shift ;                           : or,    ." or eax, eax"    2 shift 1+ ;                        : swap,  1+ ." xchg eax, [esi]"  mcomment ." swap"  2 shift ;   : nip,   2 + ." add esi, 4"      mcomment ." nip"   3 shift ;  n e                                                              : if 1+ dup c@ . mcomment 2 shift ;                             : jz,    ." jz   "  if  ." <>if"  ;                             : jng,   ." jng  "  if  ." <if"   ;                             : jnz,   ." jnz  "  if  ." =if"   ;                             : jnl,   ." jnl  "  if  ." >if"   ;                             : jc,    ." jc   "  if  ." ?if"   ;                             : cmp,   ." cmp eax, [esi]" 1+ mcomment ." (if)"   2 shift ;   n e                                                              : nop,   ." nop"               mcomment ." then"   1 shift ;    : add,   ." add eax,[esi]"     comment             2 shift 1+ ; : sub,   ." sub [esi],eax"     comment             2 shift 1+ ; : mul,   ." mul dword [esi]"   comment             2 shift 1+ ; : show_it dup c@ >r dup 1+ r@ type r> dup 1+ shift + ;          : string, ." string"      tab  comment             show_it ;                                                                   n e                                                              create opcodes                                                  $e8 1, $e9 1, $c3 1, $ad 1, $40 1, $48 1,                       $f9 1, $f8 1, $50 1, $89 1, $58 1, $09 1,                       $87 1, $83 1, $74 1, $7e 1, $75 1, $7d 1,                       $72 1, $3b 1, $90 1, $03 1, $29 1, $f7 1,                       $eb 1,                                                                                                                         n e                                                              create handlers                                                 ' call, ,  ' jmp, ,  ' ret,  ,  ' lodsd, ,  ' inc, ,  ' dec,  , ' stc,  ,  ' clc, ,  ' push, ,  ' mov,   ,  ' pop, ,  ' or,   , ' swap, ,  ' nip, ,  ' jz,   ,  ' jng,   ,  ' jnz, ,  ' jnl,  , ' jc,   ,  ' cmp, ,  ' nop,  ,  ' add,   ,  ' sub, ,  ' mul,  , ' string, ,                                                                                                                    n e                                                              : handle nip 1- 4 * handlers + @ execute 0 id ! ;               : adjust + 1- c@ over ;                                         : lookup 25 for opcodes r@ adjust =if r@ handle then next ;     : other found? 0; drop h. 1 shift tab comment ." unknown" ;     : dasm .addr lookup other cr ;                                                                                                                                                                 n e                                                              : .name dup src ! ;                                             : setup .name 2 done ! 5 diff ! ;                               : disasm setup repeat unknown read dasm done @ 0; drop again ;  here ] ' ?if disasm cr drop ;; then word? @ execute cr ;       ;loc alias inspect                                                                                                                                                                              n e                                                             loc:                                                              variable src   : +src src @ 16 + src ! ;      : .| ." | " ;     : digit 15 and dup 9 >if 10 - 'A + emit ;; then '0 + emit ;     : read dup c@ 16 /mod digit digit space 1+ ;                    : .hex src @ swap for read next drop ;                          : max? $7f <if -1 ;; then 0 ;   : min? $1f >if -1 ;; then 0 ;   : print? dup max? swap min? and -1 ;                          n e                                                               : dochar dup print? =if emit ;; then drop '. emit ;             : .type .| src @ swap for dup c@ dochar 1+ next drop cr ;       : .addr src @ hex . .| decimal ;                                : adjust 16 /mod swap dup 16 <if -rot then swap ;               : pad 16 swap - for space space space next ;                    : rest 0; dup dup .addr .hex pad .type ;                        : first adjust src ! dup 0 =if drop rest r> drop ;; then ;    n e                                                               here ] first for .addr 16 .hex 16 .type +src next rest ;      ;loc alias dump                                                                                                                                                                                                                                                                                                                                                                                                                                                 