Artifact 295342dee0dd1877b5f9cf139e71d529f2766aec

File debug.rx part of check-in [e091b5413a] - update debug.rx for latest image. refactor the code a bit as well. by charleschilders on 2010-09-20 00:53:43. [annotate]

( Copyright [c] 2010, Charles Childers                        )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

global with console'

{{
  ( Helpers to make the code easier to read ~~~~~~~~~~~~~~~~~ )
  : case:     ( nn-   ) ` over ` =if ` space ; immediate
  : ;case     ( nn-n  ) ` nip ` ;then ; immediate

  ( Resolve addresses to headers ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  : header?   (  a-af ) dup xt->d ;
  : xt->name  (  a-$  ) xt->d d->name ;
  : .name     (  a-   ) xt->name puts  space ;
  : <call>    (  n-   ) red "<call " puts putn '> emit space ;
  : resolve   (  n-   ) header? if .name ;then <call> ;
  : (name)    (  a-   ) yellow '( emit space .name ') emit space ;
  : (resolve) (  n-   ) header? if red dup putn space (name) ;then red putn space ;

  : instr?    (  n-f  )
     0 case: "nop"   puts  0 ;case
     1 case: "lit"   puts -1 ;case
     2 case: "dup"   puts  0 ;case
     3 case: "drop"  puts  0 ;case
     4 case: "swap"  puts  0 ;case
     5 case: "push"  puts  0 ;case
     6 case: "pop"   puts  0 ;case
     7 case: "call"  puts -1 ;case
     8 case: "jump"  puts -1 ;case
     9 case: ";"     puts  0 ;case
    10 case: ">jump" puts -1 ;case
    11 case: "<jump" puts -1 ;case
    12 case: "!jump" puts -1 ;case
    13 case: "=jump" puts -1 ;case
    14 case: "@"     puts  0 ;case
    15 case: "!"     puts  0 ;case
    16 case: "+"     puts  0 ;case
    17 case: "-"     puts  0 ;case
    18 case: "*"     puts  0 ;case
    19 case: "/mod"  puts  0 ;case
    20 case: "and"   puts  0 ;case
    21 case: "or"    puts  0 ;case
    22 case: "xor"   puts  0 ;case
    23 case: "<<"    puts  0 ;case
    24 case: ">>"    puts  0 ;case
    25 case: "0;"    puts  0 ;case
    26 case: "1+"    puts  0 ;case
    27 case: "1-"    puts  0 ;case
    28 case: "in"    puts  0 ;case
    29 case: "out"   puts  0 ;case
    30 case: "wait"  puts  0 ;case
    space resolve 0 ;

  : 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 ;
  : row       ( a-a )
    cyan dup putn space @+ instr? if @+ space (resolve) then cr ;
  : decompile ( a-  ) repeat row end? again ;

  ( Interactive browsing of memory ~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  variable x
  : rows @fh 2 - ;
  : handle
    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
    drop ;
  : browse (  - ) repeat clear @x rows for row next drop handle again ;
---reveal---
  : see    ( "- ) ' 0; cr decompile normal ;
  : nav    ( a- ) !x browse normal ;
}}

global