• branch=trunk inherited from [dc67bca1f3]
• sym-trunk inherited from [dc67bca1f3]

Added debug.rx version [a0f30a6955738c75]

@@ -0,0 +1,84 @@
+( 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 type space ;
+  : resolve   (  n-   ) header? if .name ;then red ." <call " (.) '> emit space ;
+  : (resolve) (  n-   ) header? if red dup . yellow '( emit space .name ') emit space ;then red . ;
+
+  : instr?    (  n-f  )
+     0 case: ." nop"     0 ;case
+     1 case: ." lit"    -1 ;case
+     2 case: ." dup"     0 ;case
+     3 case: ." drop"    0 ;case
+     4 case: ." swap"    0 ;case
+     5 case: ." push"    0 ;case
+     6 case: ." pop"     0 ;case
+     7 case: ." call"   -1 ;case
+     8 case: ." jump"   -1 ;case
+     9 case: ." ;"       0 ;case
+    10 case: ." >jump"  -1 ;case
+    11 case: ." <jump"  -1 ;case
+    12 case: ." !jump"  -1 ;case
+    13 case: ." =jump"  -1 ;case
+    14 case: ." @"       0 ;case
+    15 case: ." !"       0 ;case
+    16 case: ." +"       0 ;case
+    17 case: ." -"       0 ;case
+    18 case: ." *"       0 ;case
+    19 case: ." /mod"    0 ;case
+    20 case: ." and"     0 ;case
+    21 case: ." or"      0 ;case
+    22 case: ." xor"     0 ;case
+    23 case: ." <<"      0 ;case
+    24 case: ." >>"      0 ;case
+    25 case: ." 0;"      0 ;case
+    26 case: ." 1+"      0 ;case
+    27 case: ." 1-"      0 ;case
+    28 case: ." in"      0 ;case
+    29 case: ." out"     0 ;case
+    30 case: ." wait"    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 . @+ instr? if @+ space (resolve) then cr ;
+  : decompile ( a- ) repeat row end? again ;
+
+  ( Interactive browsing of memory ~~~~~~~~~~~~~~~~~~~~~~~~~~ )
+  variable x
+  : handle
+    key
+      'i case: x --  drop ;then
+      'k case: x ++  drop ;then
+      'j case: 20 -x drop ;then
+      'l case: 20 +x drop ;then
+      'z case: rdrop drop ;then
+    drop ;
+  : browse ( - )
+    repeat
+      clear
+      @x 20 for row next drop
+      handle
+    again ;
+---reveal---
+  : see ( "- )
+    ' 0; cr decompile normal ;
+  : nav ( a- ) !x browse normal ;
+}}
+
+global