( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2009-2010                                     )
(   Charles Childers                                          )
(   Luke Parrish                                              )
(   Marc Simpson                                              )
(                                                             )
( License: ISC                                                )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )

vocab debug
((
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Display a list of all named words                           )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: words ( - )
  fastRender last repeat @ 0; dup d->name type space again ;


( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Display values on the stack                                 )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{{
  : display  ( - )
    depth 0; here !
    here @ for pop swap push push next
    here @ for pop pop dup . swap push next
  ;
  : <depth> char: < emit depth (.) char: > emit space ;
---reveal---
  : .s <depth> display cr ;
}}


( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( see <word>                                                  )
( Provides a human readable display of the compiled code for  )
( a word.                                                     )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{{
  variable addr
  : pad       ( -   ) addr @ @ 6 for dup base @ r pow <if space then next ;
  : wrap      ( -   ) ." ( " later ."  )" ;
  : name      ( a-  ) wrap d->name type ;
  : resolve   ( -   ) addr @ @ xt->d dup if name ;then drop ;
  : .op       ( a-  ) dup getLength swap type 10 swap -
                      dup 0 <if drop space ;then for space next ;
  : .word     (  -  ) addr @ @ . pad resolve drop ;
  : .value    (  -  ) addr ++ .word ;

  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  ( Table words                                                 )
  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  : pair 0 , ; immediate

  : skip-pair ` 2 ` + ; compile-only
  : skip-nop  ` dup ` @ ` 0 ` =if ` 1+ ` then ; compile-only
  : .pair   ( a- ) 1+ skip-pair .op .value ;
  : .single ( a- ) skip-pair .op ;
  : .lookup ( an-a2 )
    repeat dup 0 =if drop
      dup @ 0 =if ( this is a pair ) .pair ;then .single ;then
      ( offset-- ) 1- swap  skip-nop
      ( jump add ) 1+ @     skip-pair swap
    again ;
  : table: create ] does> swap .lookup ;

  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  ( Opcode Table                                                )
  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
  table: (decompile)
          s" nop"           ( opcode: 0 )
    pair  s" lit"           ( opcode: 1, takes argument )
          s" dup"           ( opcode: 2 )
          s" drop"
          s" swap"
          s" push"
          s" pop"
    pair  s" call"
    pair  s" jump"
          s" ;"
    pair  s" >jump"
    pair  s" <jump"
    pair  s" !jump"
    pair  s" =jump"
          s" @"
          s" !"
          s" +"
          s" -"
          s" *"
          s" /mod"
          s" and"
          s" or"
          s" xor"
          s" <<"
          s" >>"
          s" 0;"
          s" 1+"
          s" 1-"
          s" in"
          s" out"
          s" wait"
  ;

  : .paren ( a- ) char: ( emit space . char: ) emit ;
  : .quote ( a- ) char: ' emit dup emit char: ' emit space ;
  : .ascii?   ( a- )
    dup 32 128 within if ." Char: " .quote .paren ;then
    drop s" <call>" .op .word ;; dup xt->d d->name .op .paren ;

  : decompile ( - )
    addr @ @ dup 0 30 within
    if (decompile) else .ascii? then ;

  stub more?
  {
    : header?
      addr @ @ 9 = 0; drop
      addr @ 1+ @ 30 >if addr @ . decompile rdrop rdrop then ;
    : vector? addr @ @ 0 =if addr @ 1+ @ 0 =if rdrop rdrop then then ;
    : here?   addr @ here >if rdrop rdrop then ;
    here ] here? vector? header? ; is more?
  }
---reveal---
  : :see  ( a- )
    0; addr ! cr repeat addr @ . decompile cr addr ++ more? again ;
  : see   ( "- ) ' :see ;
}}
))