SOURCE

: SEE.IVOS	." IVOS 32-bit TOKEN Forth Decompiler and HELP words" ;


// HEADS  LINK(4),ATR(1),NAME(V),0..

: NOTE"		E9h C, COMPILE> $" DROP ;

NOTE" ( cfa -- ) Print the HELP comment"

: .NOTE
	CFA>NFA 5 -
 		BEGIN 1- DUP C@ DUP E9h = SWAP 0FFh = OR UNTIL
 	DUP C@ E9h = IF 1+ 0 TYPE ELSE DROP THEN
 	;


: .HWORD
	  
	  CR
	  1 2 REG +!
	  1 REG @ 28d SHR IF MAGENTA ELSE CYAN THEN FG
	  1 REG @ NFA>CFA DUP >R .H
	  SPACE BLUE FG
	  R@ 1 REG @ 5 - - 3 REG +!
	  1 REG @ 1- C@					\ read attribute
	  DUP FF XOR 2 U.N SPACE PLAIN
	  DUP 20h AND 0= IF RED FG THEN
	  40h AND 0= IF YELLOW BG THEN
	  1 REG @ 0 TYPE PLAIN YELLOW FG
	  R> SPACE .NOTE PLAIN
	  15d 1 REG @ LEN -  1 MAX SPACES
	  1 REG @ NFA+ DUP 1 REG !
	  0= ESC? OR
	;

NOTE" List Forth dictionary with CFA and HELP comments "

: HWORDS
	0 4 REG !
	'"' PARSE IF 4 REG ! ELSE DROP THEN
	CR HEX
	0 2 REG !					\ word count
	0 3 REG !					\ header count
	BL PARSE IF 6 REG ! ELSE DROP THEN
	CONTEXT @ 1 REG !
	  BEGIN .HWORD UNTIL
	DECIMAL
	CR ." Totals words     " 2 REG @ .
	CR ." Total word space " 3 REG @ .
	CR HEX 
	;

NOTE" ( <word> -- ) Find the word and display the HELP comment if it exists"

: HELP	 	' ?DUP	IF .NOTE ELSE HWORDS THEN ;





: ESC		^[ EMIT EMIT ;
: .N		BASE C@ >R DECIMAL 0 .R R> BASE C! ;
: CUR           '[' ESC SWAP .N EMIT ;
: XTAB	 	'C' CUR ;


// compo	=	bit(6)			;lexicon compile only bit
// immed	=	bit(5)		 	;lexicon immediate bit

: .ATR
	DUP 6 MASK AND 0= IF ." ;Compile Only" THEN
	DUP 5 MASK AND 0= IF ." ;Immediate" THEN
	DROP
	;

: .HEAD
	HEX
	DUP CFA>LFA	CR DUP .H ." : LFA    " @ DUP .H
	DUP 0< IF OVER CFA>LFA + ."  (=" .H ." )" ELSE DROP THEN
	DUP CFA>NFA 1-	CR DUP .H ." : ATR    " C@ DUP .BYTE SPACE .ATR
	DUP DUP CFA>NFA	CR DUP .H ." : NFA    "
		DO I C@ .BYTE SPACE LOOP
	 		CR DUP .H ." : CFA    " DUP CFA>PFA OVER - 2/ 2/ BOUNDS
		DO I @ 8 U.N SPACE LOOP
	;

: .ID		0D EMIT 24d XTAB DUP 1- C@ 0= IF CFA>NFA 0 TYPE ELSE 5 U.N THEN ;
: .TOKEN
	2* 2* 400h + @ DUP -1 <>
	  IF .ID SPACE 
	  ELSE DROP
	  THEN
	;

: .TOKEN1
	EFh >
	  IF DUP 1+ C@ 2 U.N DUP C@ .TOKEN 1+
	  ELSE
	  DUP C@ .TOKEN
	  THEN
	;

: .NUM
	1 CASE .BYTE ENDCASE
	2 CASE .WORD ENDCASE
	4 CASE .H ENDCASE
	DROP .DEC
	;
	
: .LIT	( adr1 sz -- adr2 ) \ 1 2 4
	>R DUP 1+ NA@ R@ .NUM DUP C@ .TOKEN R> + ;

: SEE:	( token -- )
	FDh CASE 1+ DUP H@ DUP .WORD SPACE
	2* 2* .ID 1+ ENDCASE
	FEh CASE 1+ DUP H@ DUP .WORD SPACE
	OVER 2 + SWAP - .ID 1+ ENDCASE
	FFh CASE FFh .TOKEN CR ENDCASE

	E0h CASE 1 .LIT ENDCASE
	E1h CASE 2 .LIT ENDCASE
	E2h CASE 4 .LIT ENDCASE

	E8h EFh CASES ." str" DUP C@ .TOKEN DUP 1+ 0 TYPE DUP LEN + ENDCASE

	.TOKEN1
	;


: SEES
	HEX '
	?DUP IF DUP .HEAD CR
	CFA>PFA
	  BEGIN
	  CR DUP .H ." : "
	  DUP C@ 2 U.N SPACE
	  DUP C@ FF <>
	  1 REG @ IF 'V' CMD 1+ C@ 01Bh <> OR THEN
	  WHILE
	  DUP C@ SEE:
	  1+
	  REPEAT
	C@ SEE:
	THEN
	;


: SEE	0 1 REG ! SEES ;
: SEE+	1 1 REG ! SEES ;



FINIS