\ tools   11/27/97   gwj
\ standard 
\ requires string wordset
\ and version 0.5.7 or greater
create tools \ can test for existence

: ?  ( a-addr -- )   @ . ;

\ non-standard utility words
\ print 2 digits unsigned, current base
: ##  ( n -- addr cnt ) 0 <# # # #> ;

\ append a char to a string
: +char  ( c $ -- )  
tuck count + c! dup c@ 1+ swap c! ;

8 dup constant dmp-len
char+ create dmp$ allot

: >dmp$  ( c -- )  
dup 32 < over 127 > or
if drop [char] . then dmp$ +char ;
: .dmp$  ( -- )   dmp-len dmp$ c@ -
0 max 6 * 3 + spaces dmp$ count
type ;

: dmp.endln  ( addr ndx -- addr )  
1+ dmp-len mod 0= 
if .dmp$ cr 0 dmp$ ! then ;

\ standard 
\ hex memory dump utility
: dump  ( addr len -- ) 
cr 0 dmp$ !  base @ >r hex 0
do dup i + c@ dup ## type space
>dmp$ i dmp.endln loop
 .dmp$ cr drop  r> base ! ;

: [else]  ( -- )
   1 begin                               \ level
     begin  bl word count  dup  
     while    \ level adr len
       2dup  s" [if]" icompare 0=
       if           \ level adr len
              2drop 1+               \ level'
       else                        \ level adr len
             2dup  s" [else]"  icompare 0=
             if    \ level adr len
                 2drop 1- dup
                 if 1+ then  \ level'
             else               \ level adr len
                 s" [then]"  icompare 0=
                 if  1-  then
            then
       then ?dup 0=  if exit then   \ level'
     repeat  2drop                       \ level
   refill 0= until                       \ level
  drop
; immediate

: [if]  ( f -- )
   0= if postpone [else] then
; immediate

: [then]  ( -- )  ;  immediate