\ Tools for noForth C and V for all versions 01apr2016 or newer)
\ .S MANY WORDS DUMP SEE

\ (C) 2015, 2016, 2017 -- Albert Nijhof & Willem Ouwerkerk
\  Last update 22feb2017

( The following words can be loaded both to noForth C and noForth V.
  Lines starting with V: are skipped in noForth C
  Lines starting with C: are skipped in noForth V
  If you want to load only a selection of these tools,
  we recommend to type
        v:  fresh
        shield TOOLS\ freeze
  after you have added your selection from these words
  to the noForth kernel. See at end of this file.
)

HEX     \ until end of file.
\ -----
: .S    ( -- )
    ?stack (.) space
    depth false
    ?do depth i - 1- pick
        base @ 0A = if . else u. then
    loop ;

\ -----
: STOP? ( - true/false )
    key? dup 0= ?EXIT  drop
    key  bl over = if drop key then
    hx 1B over = ?abort
    bl <> ;

\ ----- MANY
' stop? drop
: MANY  ( -- )  >in @ stop? and >in ! ;

\ ----- WORDS
' stop? drop
v:  inside 0 v0 c!
: WORDS   ( -- )
v:  [ fresh inside ]
c:  0 >r    \ see IWORDS
    0 >r                               \ word count
    fhere
    [ adr pfx-link hot - ] literal
    hot dup
    2over move drop                     \ threads > fhere
    bounds
    cr
    begin false dup                     \ threada lfa
        2over
        do  dup i @ u<
            if  2drop i dup @
            then                        \ threada lfa
        2 +loop
        dup stop? 0= and
    while                               \ threada lfa
v:      dup @voc vp c@ =                \ the right vocabulary?
c:      dup 1+ c@ hx 40 and 2r@ drop =  \ 0 for WORDS, 40 for IWORDS
        if  r> 1+ >r                    \ counting
\            r@ 9 mod 0= if cr then space
\            dup lfa>n count 1F and type space
            dup lfa>n count 1F and
            hor over + 48 u> if cr then
            space type space
        then
v:      @ swap !                        \ unlink \ v
c:      lnk@ swap !                     \ unlink \ c
    repeat
    2drop 2drop
v:  r>
c:  2r> nip
    (.) 0 .r ;

c:  : IWORDS    hx 40 [ ' words 4 + ] literal >r ;

\ ----- DUMP
: pchar ( x -- )    dup hx 7F < and bl max ;

(*
' stop? drop
' pchar drop
: DUMP  ( a n -- )
v:  [ inside ]
    over + 1- >r                                \ r: enda-1
    hx FF s>d du.str nip 1+ swap                \ .r a
    base @ swap
    begin
        cr dup 2over drop 2* u.r ." : "        \ .r base a
        over s>d
        do  count 2over drop .r
        loop
        over - ."  |"               \ .r base a
        over s>d do count pchar emit loop ." |" \ .r base a+
        r@ over - 0< stop? or
    until
    r> 2drop 2drop ;

\ ----- SEE & MSEE
: >NFA          ( a -- nfa | 0 )
    dup origin
    chere within                    \ in noForth rom?
    if  dup 1 and 0=                \ even?
        if  1- dup c@ hx FF = +     \ skip alignment char
            0
            begin
                over c@ hx 21 hx 7F within  \ char?
            while
                -1 /string hx 20 over <     \ walk backwards through name
            until
            then
            ?dup                        \ nfa? count-non-zero?
            if  over c@
v:              hx 7F and =         \ count ok?
c:              hx 3F and =         \ count ok?
                if  dup 1 and ?exit     \ nfa odd -> ok
                then
            then
        then
    then
    drop 0 ;

' pchar drop
' >nfa drop
v:  inside definitions
: decom         ( a -- )
v:  [ fresh inside ]
    cr dup 6 u.r space      \ .adr
    dup count pchar emit c@ pchar emit  \ .2chars
    dup @ 6 u.r space                   \ .contents
    dup >nfa ?dup
    if  ." ----- "
v:      dup 1- c@ hx 7F and .voc
        count tuck hx 1F and type           \ .name
        hx 80 < if ."  (imm)" then
        @ cell- >nfa ?dup
        if  ."  does " count hx 1F and type \ .doer
        then
        EXIT                            \ ----
    then
    dup @                               \ contents
    dup 1 and                           \ odd?
    if  dup hx -7000 hx 7000 within     \ a number?
        if 2/ ." #" u. drop EXIT
        then
        ahead
[ chere >r
  hx 77FF , s" AGAIN -" dup c, m,
  hx 7FFF , s" AHEAD +" dup c, m,
  hx 87FF , s" UNTIL -" dup c, m,
  hx 8FFF , s" IF +"    dup c, m, align
]
        then
[ r> ] literal
        begin 2dup @ u>
        while cell+ count +
        repeat
        cell+ count type
        hx FFF and hx 7FF - + ." > " u. EXIT
    then
    nip dup >nfa ?dup
    if  count hx 1F and type drop EXIT  \ .name of compiled word
    then
    dup hot here within                 \ ram location?
    if  origin
        begin
            begin
                cell+ chere over u<
                if  2drop EXIT
                then
                2dup @ =
            until
            dup cell- >nfa ?dup
            if  count 1F and type
                ."   RAM location "
            then
        again
    then
    hx 4F00 = if ." nxt jmp "  then ;

: MSEE ( a -- )
v:  [ inside ]
    hx FFFE and
    begin 8 0 do dup decom cell+ loop
          key 01B over = ?abort bl <>
    until drop ;
: SEE   ( <name> -- )   ' msee ;
*)

\ -----
v:  fresh
shield TOOLS\ freeze
\ <><>
