\ tools.fth -- SEE, in FORTH.
\
\ This file is FORTH source, compiled by the node a line at a time; no line
\ is longer than 79 characters.
\
\ v4 code is native: a definition is instruction words, six five-bit opcodes
\ to a word, so SEE is a disassembler.  It prints the name, then each
\ instruction word on a line: the opcodes by name, a literal's value after
\ its @p, and after a call or a branch the name of the word it goes to, or
\ the address if that is not a word.  Text compiled by ." S" or ABORT" is
\ shown in quotes after the call it follows.  Padding (nop) is not shown.
\ It stops at the first ; ex or jump that no earlier branch goes past.

FORTH DEFINITIONS

\ the opcode names, five characters each, in the order of their numbers
: (OPS1) S" ;    ex   jump call unextnext if   -if  @p   @+   @b   @    " ;
: (OPS2) S" !p   !+   !b   !    +*   2*   2/   inv  +    and  xor  drop " ;
: (OPS3) S" dup  pop  over a    nop  push b!   a!   " ;
: (.OP) ( op -- )
  DUP 12 < IF (OPS1) ELSE DUP 24 < IF 12 - (OPS2) ELSE 24 - (OPS3) THEN THEN
  DROP SWAP 5 * + 5 -TRAILING TYPE ;

VARIABLE (SP)    \ the address after the instruction word being shown
VARIABLE (SW)    \ that word
VARIABLE (SK)    \ the slot
VARIABLE (SOP)   \ the opcode last shown
VARIABLE (SLITS) \ how many literals the word has had so far
VARIABLE (SEND)  \ the furthest a branch has gone forward
VARIABLE (SN)    \ how many lines

\ ( -- xt )  the newest word of FORTH
: (HEAD)  CONTEXT @ >R [COMPILE] FORTH CONTEXT @ @ R> CONTEXT ! ;
\ ( addr xt -- baddr | 0 )  the name of the word at addr, in the list from xt
: (IN-LIST)
  BEGIN DUP WHILE 2DUP = IF SWAP DROP >NAME EXIT THEN >LINK @ REPEAT
  SWAP DROP ;
\ ( addr -- )  its name if it is a word, else the number
: (.ADDR)
  DUP CONTEXT @ @ (IN-LIST) ?DUP 0= IF DUP (HEAD) (IN-LIST) THEN
  ?DUP IF COUNT 31 AND TYPE DROP ELSE 0 .R THEN ;
\ ( -- addr )  where the branch in this slot goes
: (TARGET)
  1 27 (SK) @ 5 * - LSHIFT 1-
  DUP INVERT (SP) @ AND  SWAP (SW) @ AND OR ;
\ ( addr -- )  after a call to addr: if it is one of the words that are
\ followed by text, show the text and count its cells with the literals
: (TEXT?)
  DUP ['] (.") = OVER ['] (ABORT") = OR OVER ['] (LOG") = OR
  SWAP ['] (S") = OR IF
    (SP) @ (SLITS) @ + 4 *  COUNT  34 EMIT 2DUP TYPE 34 EMIT SPACE
    SWAP DROP 4 + 4 / (SLITS) +!
  THEN ;
\ ( -- flag )  show this slot; true if the instruction word ends with it
: (SLOT)
  (SW) @ 27 (SK) @ 5 * - RSHIFT 31 AND
  DUP 28 = IF DROP 0 EXIT THEN
  DUP (SOP) !  DUP (.OP) SPACE
  DUP 8 = IF (SP) @ (SLITS) @ + @ . 1 (SLITS) +! THEN
  DUP 2 = OVER 3 = OR OVER 5 = OR OVER 6 = OR OVER 7 = OR IF
    (TARGET) DUP (.ADDR) SPACE
    SWAP 3 = IF (TEXT?) ELSE (SEND) @ MAX (SEND) ! THEN
    -1 EXIT
  THEN
  2 < ;
: (SEE-LINE) ( -- )
  (SP) @ @ (SW) !  1 (SP) +!  0 (SLITS) !  0 (SK) !  28 (SOP) !
  2 SPACES
  BEGIN (SLOT) IF -1 ELSE 1 (SK) +! (SK) @ 6 = THEN UNTIL
  CR  (SLITS) @ (SP) +! ;
: (SEE-CODE) ( xt -- )
  DUP (SP) ! (SEND) !  0 (SN) !
  BEGIN (SEE-LINE) 1 (SN) +!
    (SOP) @ 3 <  (SP) @ (SEND) @ > AND  (SN) @ 63 > OR
  UNTIL ;

\ SEE xxx   show the word xxx
: SEE
  FIND DUP 0= ABORT" SEE: not found"
  ." : " DUP >NAME COUNT 31 AND TYPE CR
  DUP 3 - @ 4 AND IF ."   data: " DUP 1+ @ . CR ELSE DUP (SEE-CODE) THEN
  3 - @ 1 AND IF ." IMMEDIATE" CR THEN ;