// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  
// Two main words: Decompiles and Words
// This also contains useful words for looking  at the forth 
// header
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  
//
// HISTORY:
//  * v1.15 uses locals
//  * aborts if word not found


// simply emits tab or spaces to align
// columns
: tab1 9 emit ;    

// checks for exit signature and aborts if found
// does not abort, returns true when exit found
: dc1  { v sig --- } // ( v, sig --- [sig] v- or v) checks termination
sig
exitaddress    // terminating signature
-
0= if
    sig ph. tab1 ." Exit"
    v 1-      // decrement v
else
    v    
then ;

// fetches a char from the address and if printable
// prints it else prints a dot
// ( addr --- [dot or ASCII])
: dc2a  { addr }
  addr ?c@ 32 122 between
  if 
    addr ?c@ emit 
  else 
    46 emit    // 46 is dot 
  then
;    

// prints out 7 characters from given address
// ( addr ---) just o/p 8 char
: dc2  { addr }  
7 0 do
    addr dc2a
    1 +> addr
loop 
;

// given the cfa, prints the address followed by the 
// text word
// (cfa --- ) prints word or number
: dc3  { cfa }
cfa ph. tab1 // print address
cfa 12 - ?@ &f00 and &900 =   // test for valid header
if          // print header
    cfa 8 - // move to name field 
    dc2 
else 
    cfa ?@ ph.      // just print contents
then 
cr
;

// ------------- DECOMPILE ----------------------------
// special form for words that have more than one exit
// can specify how many exits to parse
// Explain: decompile will decompile from the colon definition
// the the word EXIT - EXIT is compiled by ; normally, but some
// words have more then one exit. Use like this
// decompile FRED
// or
// 2 decompile BOB
// NOTE ONLY FORTH WORDS CAN BE DECOMPILED
: <0>decompile  ( [exits] -- ccc ) // use decompile xxx
int#: exits 1
int: cfa cfa-n
depth 0 > if => exits then
cr
." Addr" tab1  // tab
." Wrd-Adr" tab1
." Name" tab1
cr
?'  => cfa   // get cfa of word
cfa 0= abort" Word not found"
cfa u. tab1 // print address of word to decompile
cfa 8 - stype   // and its name
cfa 12 - @ 16 rshift tab1 ." Hash = " ph. cr  // hash
begin
  4 +> cfa   // advance to next word
  cfa u. tab1  // print address
  cfa ?@ => cfa-n    // fetch CFA of next word
  exits cfa-n dc1 => exits // dec when exit found
  exits 0= if abort then  
  cfa-n dc3       // print word or number
again  
;

// given the link field address, returns the name field address
//  ( lfa --- nfa )
: nfa
    8 +
;

// type will return &2000 or 0, Word type. 0 is code word and &2000 is
// a forth word
//  ( lfa --- type)
: wtype
    4 + @ &2000 and
;

// immediate will return $8000 or 0, returns &8000 if imediate word
// (lfa --- imed)
: wimed
    4 + @ &8000 and
;                

// simply outputs text for head
: whead
    cr
    ." Name    Hash    Type    Immediate" cr
;

// outputs one line of text
//  (lfa ---)
: wline
    dup nfa stype space // name
    dup 4 + @ &ffff0000 and 16 rshift <# # # # # #> stype 4 spaces
    dup wtype if ." Code    " else ." Forth   " then
    wimed if ." Immediate" then  
;        

// ------------- WORDS ---------------------------------------
// This will list all of the words, in the order that they were created
// in the current system
: <0>words
    whead
    latest        // LFA of latest
    begin
        @ dup 0= if drop escape then   // no more
        dup wline cr 
    again
;      

// prints out hash of a word, just a utility
: hash
    bl word toupper rshash &0000ffff and ph. 
;