( "DECOM1" A RECURSIVE FORTH DECOMPILER ) ( for the HP 71B ) ( by George G. Pinney (462) HEX ( LOAD IN HEX) VARIABLE NEST ( = Depth of nesting) VARIABLE RFLAG ( 0 for Prim.,Defining or RTA) VARIABLE 1STEP ( Load non 0 to single step) -1 CONSTANT -1 : 1STEP? 1STEP @ 0= NOT ; : ?NEST NEST @ DUP 0> ( Checks depth of) IF 0 DO ( nesting. Display) 2A EMIT SPACE LOOP ( * for each layer in.) ELSE DROP THEN ; : DEC. BASE @ SWAP DECIMAL . ." D." BASE ! ; : SCROLL " SCROLL 1" BASICX ; : HD. DUP H. ." H. " DEC. ; ( D. is signed) : DUP@ DUP @ ; ( H. is not) : 2SPACE 2 SPACES ; : ADR. DUP U. 2SPACE ; ( Addr---Addr) : PRIM? DUP DUP >BODY SWAP @ = ; ( CFA---CFA,f) : IMMED? C@ 40 AND 0> ; ( NFA---f) : SCOLON? DUP@ E71E8 = ; ( PFW---PFW,f) : COLON? DUP@ E701A = ; ( CFA---CFA,f) : >NAME 2- -1 TRAVERSE ; ( CFA---NFA) : NAME> 1 TRAVERSE 2+ ; ( NFA---CFA) : MYSELF LATEST NAME> , ; IMMEDIATE : -RFLAG 0 RFLAG ! ; ( Disallow Recursion) : +RFLAG -1 RFLAG ! ; ( Allow Recursion) : .NAME DUP COUNT ( NFA---Print ) 1F AND 1- TYPE 1 TRAVERSE C@ 7F AND EMIT ; : "STR+ 22 EMIT SPACE TYPE 22 EMIT COUNT 2* + 5- ; ( ---Type str.,next PFA) : ?ROM F0000 AND E0000 = IF ." (r)" THEN ; : HEADER. DUP >NAME ADR. DUP .NAME 2SPACE ?ROM ; : VAR? DUP DUP 5- >NAME ( PFA---PFA,F) SWAP 5+ DUP@ ( Is PF 8 bytes ?) ROT = SWAP HERE = OR ; ( True = FVAR) : ?KEY BEGIN KEY CASE 51 ( Q) OF ABORT" done" ( Any time) ENDOF 49 ( I) OF RFLAG @ ( If prim., RTA,or) IF 49 -1 ELSE 0 THEN ( defining word---continue loop) ENDOF 4F ( O) OF NEST @ 0> ( if not in a layer) IF 4F -1 ELSE 0 THEN ( continue loop) ENDOF DROP SCOLON? ( if ; only key is Q or maybe O) IF 0 ELSE 50 -1 THEN DUP ( key 50 is arbitrary) ENDCASE UNTIL ; ( so back to COLON & next word) : ?DEFINE CASE ( Is it a Defining Word ?) E706D OF EXECUTE VAR? IF @ ." VAR = " HD. ELSE ." FVAR = D. " RCL F. FDROP THEN -RFLAG ENDOF E702F OF EXECUTE ." CON = " HD. -RFLAG ENDOF E7043 OF EXECUTE ." FCON = D. " F. FDROP -RFLAG ENDOF E7080 OF ." STR Max. Chars. = " 5+ C@ DEC. -RFLAG ENDOF E70B7 OF ." STR-ARRAY " 5+ DUP 2+ C@ DEC. ." Elements of " C@ DEC. ." Chars. Max." -RFLAG ENDOF DUP@ 13BF8 OF ." Son of " ( Defined by ?) BEGIN 5- COLON? UNTIL >NAME ." <" .NAME ." >" DROP -RFLAG ENDOF 2DROP ENDCASE ; : (PFW) DUP ( PFA+5,PFW---) >NAME ( PFW is a CFA,get NFA) DUP IMMED? IF ." [COMPILE] " THEN DUP .NAME 2SPACE ?ROM PRIM? ( Print NAME) IF ." (p)" -RFLAG THEN DROP 5- DUP@ DUP@ ?DEFINE DUP ; : ?RTA DUP 5+ SWAP @ ( PFA---PFA+5,PFW) -RFLAG CASE ( Run time address ?) E1C54 ( Literal) OF ." LIT. " DUP@ DUP DUP 80000 AND 0= IF ." +" THEN . 2SPACE U. ENDOF E22ED ( FLiteral) OF DUP ." FLIT. D. " RCL F. FDROP 5+ 5+ 1+ ENDOF E0EFA ( .") OF DUP COUNT ." ." "STR+ ENDOF E0640 ( ") OF 2+ DUP COUNT "STR+ ENDOF E580E ( ABORT") OF DUP COUNT ." ABORT" "STR+ ENDOF E5D86 ( IF or UNTIL or WHILE) OF DUP DUP@ DUP 0< IF ." UNTIL If false Jump to BEGIN @ " ELSE ." IF/WHILE If false Jump to " THEN + U. ENDOF E5D99 ( ELSE/REPEAT) OF DUP DUP@ DUP 0< IF ." REPEAT Jump to BEGIN @ " ELSE ." ELSE Jump to THEN @ " THEN + U. ENDOF E1C67 ( DO) OF ." DO (in loop R@=I)" 5- ENDOF E3FF1 ( LOOP) OF DUP ." LOOP Jump to DO @ " DUP@ + 5- U. ENDOF E3F81 ( +LOOP) OF DUP ." +LOOP Jump to DO @ " DUP@ + 5- U. ENDOF E0168 ( J) OF ." J" 5- ENDOF E601C ( DOES>) OF ." DOES>" 2+ ENDOF E71E8 ( ;) OF ." ;" 5- 1STEP? NOT IF SP! QUIT THEN ENDOF +RFLAG (PFW) ENDCASE CR ; : COLON ?NEST ( CFA---) ADR. ." :" ( ---CFA,Print CFA) DUP >NAME IMMED? ( ---CFA,f) IF ." (IMMEDIATE)" THEN CR ( CFA---) BEGIN >BODY ?NEST ADR. ( ---PFA,PRINT PFA) ?RTA 1STEP? IF SCROLL ?KEY CASE 49 ( I) OF 1 NEST +! DUP@ MYSELF ( in 1 layer) ENDOF 4F ( O) OF -1 NEST +! DROP R> DROP ( out 1 layer) ENDOF ENDCASE THEN +RFLAG 0 UNTIL ; : DECOM 20 WORD FIND DUP 0= ( ---CFA,f,f) ABORT" Not in Vocabulary" SWAP PRIM? ( ---f,CFA,f) IF HEADER. SWAP 0> ABORT" (Prim.,IMMEDIATE)" ABORT" (Prim.)" THEN ( drop immediate flag) SWAP DROP COLON? ( ---CFA,f) IF HEADER. CR ( true=never returns) 0 NEST ! +RFLAG COLON ( from COLON) THEN DUP HEADER. ( false=defining word) @ ?DEFINE SCROLL QUIT ;