( LOADSTART ) HEX : RAMTOP F000 MEMTOP ; RAMTOP FORGET TASK HEX E400 HERE - ALLOT 4 ALLOT : TASK ; : ON -1 SWAP ! ; : OFF 0 SWAP ! ; HEX : ZIFFER? ( Wert -- Flag ) DUP 3A < SWAP 2F > AND ; : HEX? DUP DUP 47 < SWAP 40 > AND SWAP ZIFFER? OR ; : ASCII>HEX 30 - DUP 9 > IF 7 - THEN ; CODE CLI CLI, NEXT JMP, END-CODE CODE SEI SEI, NEXT JMP, END-CODE : HEX>ASCII ( HEX -- ASCII ) A /MOD 30 OR SWAP 30 OR 100 * + ; ( R6511-DISASSEMBLER ) FORTH DEFINITIONS HEX E000 CONSTANT (BLOCK) 0130 CONSTANT ADRESS.CTR 0132 CONSTANT QUIT.FLAG 0134 CONSTANT WORD.PTR 0136 CONSTANT DOCOL.FLAG : OFFSET.DSP ADRESS.CTR @ DUP 1+ ADRESS.CTR ! DUP C@ DUP 7F > IF SWAP FF - ELSE 1+ THEN + 0 D. ; : OPCODE.DSP ( Opcode -- Flag Adr.Mode ) ( gibt Opcode aus, uebergibt Flag fuer gueltigen Opcode ) ( und Adressing Mode ) 4 * (BLOCK) + SPACE DUP C@ EMIT DUP 1+ C@ EMIT DUP 2+ C@ DUP EMIT 3F = SWAP 3 + C@ DUP 39 > IF 7 - THEN 30 - SPACE ; : BYTE.DSP ADRESS.CTR @ DUP C@ 2 .R 1+ ADRESS.CTR ! ; : DBYTE.DSP ADRESS.CTR @ DUP @ 0 <# # # # #S #> TYPE 2+ ADRESS.CTR ! ; ( Adressierungsarten ) : IMMEDIATE.DSP ." #" BYTE.DSP 3 SPACES ; : ABSOLUTE.DSP DBYTE.DSP 2 SPACES ; : ZERO-PAGE.DSP BYTE.DSP 4 SPACES ; : ACCUM.DSP ." .A " ; : IMPLIED.DSP 6 SPACES ; : (IND,X).DSP ." (" BYTE.DSP ." ,X)" ; : (IND),Y.DSP ." (" BYTE.DSP ." ),Y" ; : Z.PAGE,X.DSP BYTE.DSP ." ,X " ; : ABS.X.DSP DBYTE.DSP ." ,X" ; : ABS.Y.DSP DBYTE.DSP ." ,Y" ; : RELATIVE.DSP OFFSET.DSP SPACE ; : INDIRECT.DSP ." (" DBYTE.DSP ." )" ; : Z.PAGE,Y.DSP BYTE.DSP ." ,Y " ; : BIT-ADRESSING.DSP BYTE.DSP ." ," BYTE.DSP SPACE ; CASE: #.DSP IMMEDIATE.DSP ABSOLUTE.DSP ZERO-PAGE.DSP ACCUM.DSP IMPLIED.DSP (IND,X).DSP (IND),Y.DSP Z.PAGE,X.DSP ABS.X.DSP ABS.Y.DSP RELATIVE.DSP INDIRECT.DSP Z.PAGE,Y.DSP BIT-ADRESSING.DSP ; : DISASSEMBLE ( Adress -- Jmp-/Return-Flag Opcode-valid-Flag ) ( disassembliert einen Befehl ) DUP SPACE 0 <# # # # #S #> TYPE ( Adresse ausgeben ) DUP 1+ ADRESS.CTR ! C@ DUP ( Jmp-/Return-Flag : ) 2DUP 2DUP 0= SWAP 40 = OR SWAP 4C = OR SWAP 60 = OR SWAP 6C = OR SWAP OPCODE.DSP 0 MAX D MIN #.DSP ; : DISASS ( Adresse -- ) ( disassembliert bis JMP, RTS, RTI oder zu ungueltigem Befehl ) ADRESS.CTR ! CR BEGIN ADRESS.CTR @ DISASSEMBLE OR ?TERMINAL OR UNTIL ; : DIS ( Adresse -- ) ( disassembliert bis zu ungueltigem Befehl ) ADRESS.CTR ! CR BEGIN ADRESS.CTR @ DISASSEMBLE SWAP DROP ?TERMINAL OR UNTIL ; : NDIS ( n Adresse -- ) ( disassembliert n Opcodes bis zu ungueltigem Befehl ) ADRESS.CTR ! CR BEGIN 1- ADRESS.CTR @ DISASSEMBLE SWAP DROP OVER 0= OR ?TERMINAL OR UNTIL DROP ; ( RSC-FORTH Decompiler ) ( CASE control statement by Charles E. Eaker ) ( published in FORTH Dimensions 11/3 page 37 ) FORTH DEFINITIONS DECIMAL : CASE ?COMP CSP @ !CSP 4 ; IMMEDIATE : OF 4 ?PAIRS COMPILE OVER COMPILE = COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDOF 5 ?PAIRS COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] ENDIF 4 ; IMMEDIATE : ENDCASE 4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ = 0= WHILE 2 [COMPILE] ENDIF REPEAT CSP ! ; IMMEDIATE ( find run-time adresses of each vocabulary word type ) ' (LOOP) @ 2 - CONSTANT LOOP.ADR ' LIT @ 2 - CONSTANT LIT.ADR ' : @ 2 - @ CONSTANT DOCOL.ADR ' 0BRANCH @ 2 - CONSTANT 0BRANCH.ADR ' BRANCH @ 2 - CONSTANT BRANCH.ADR ' (+LOOP) @ 2 - CONSTANT PLOOP.ADR ' (.") @ 2 - CONSTANT PDOTQ.ADR -1911 CONSTANT CONST.ADR ' BASE @ 2 - @ CONSTANT USERV.ADR -1900 CONSTANT VAR.ADR ' (;CODE) @ 2 - CONSTANT PSCODE.ADR ' CLIT @ 2 - CONSTANT CLIT.ADR -1595 CONSTANT DOES.ADR : HLESS.DSP HEX DUP 0 D. ." Headerless " CR @ DIS DECIMAL ; : N. ( print a number in decimal and hex ) DUP DECIMAL . SPACE HEX 0 ." ( " D. ." H ) " DECIMAL ; : PDOTQ.DSP ( display a compiled text string ) WORD.PTR @ 2+ DUP >R DUP C@ + 1- WORD.PTR ! ( update PFA pointer ) R> COUNT TYPE ; : WORD.DSP ( given CFA, display the glossary name ) CONTEXT @ @ BEGIN SWAP DUP ROT DUP PFAPTR CFA ROT = IF DUP NFA 1+ @ -11461 = IF 1 QUIT.FLAG ! THEN ID. 1 ELSE PFAPTR LFA @ DUP 0= IF DROP DUP -16384 U< IF ." ;C" 1 QUIT.FLAG ! ELSE DUP HLESS.DSP THEN 1 ELSE 0 THEN THEN UNTIL DROP ; : BRANCH.DSP ( get branch offset, calculate the actual branch adress, ) ( and display it ) ." to " WORD.PTR @ 2+ DUP WORD.PTR ! ( update PFA ptr ) DUP @ + ( offset + PFA = actual target addr ) 0 HEX D. DECIMAL ( print it ) ; : USERV.DSP ( display a user variable ) ." User variable, current value = " WORD.PTR @ 2+ ( calculate PFA ) C@ 768 + ( +ORIGIN @ ) ( then user area adress ) @ N. ( fetch and print contents ) 1 QUIT.FLAG ! ( done, set flag ) ; : VAR.DSP ( display a variable ) ." Variable, current value = " WORD.PTR @ 2+ ( calculate PFA ) @ N. ( fetch and print contents ) 1 QUIT.FLAG ! ( done, set flag ) ; : CONST.DSP ( display a compiled constant ) ." Constant, value = " WORD.PTR @ 2+ ( calculate PFA ) @ N. ( fetch and print contents ) 1 QUIT.FLAG ! ( done, set flag ) ; : DOCOL.DSP ( display : or quit with ;C ) DOCOL.FLAG @ IF ." ;C" 1 QUIT.FLAG ! ELSE ." : " 1 DOCOL.FLAG ! THEN ; : DECOMPILE ( PFAPTR -- ) BASE @ SWAP ( decompiles word with given PFAPTR ) DUP DUP CFA @ SWAP ( contents of CFA ) @ = ( if contents of CFA = PFA then it is a primitive ) IF ." " CR CFA @ HEX DIS DECIMAL ELSE ( otherwise it's high level FORTH so decode it ) 0 QUIT.FLAG ! 0 DOCOL.FLAG ! ( initialize done flags ) CFA WORD.PTR ! ( initialize pseudocode pointer ) CR CR ( print some blank lines ) BEGIN ( now list the compiled pseudocode ) WORD.PTR @ DUP ( fetch current pseudocode pointer ) 0 HEX D. SPACE DECIMAL ( print value of pointer ) @ ( fetch current pseudocode word ) CASE ( now decode any special word types ) LIT.ADR OF ( compiled literal, print it's value ) WORD.PTR @ 2+ DUP WORD.PTR ! @ N. ENDOF DOCOL.ADR OF ( points to the nesting routine ) DOCOL.DSP ENDOF 0BRANCH.ADR OF ( conditional branch with in-line offset ) ." Branch if zero " BRANCH.DSP ENDOF BRANCH.ADR OF ( unconditional branch with in-line offset ) ." Branch " BRANCH.DSP ENDOF LOOP.ADR OF ( end of a DO...LOOP structure ) ." Loop " BRANCH.DSP ENDOF CLIT.ADR OF WORD.PTR @ DUP 2+ C@ N. 1+ WORD.PTR ! ENDOF DOES.ADR OF DOCOL.FLAG @ IF 1 QUIT.FLAG ! ELSE ." DOES> - word " 1 DOCOL.FLAG ! THEN ENDOF PDOTQ.ADR OF ( display compiled text string ) ." Print text: " PDOTQ.DSP ENDOF USERV.ADR OF ( display a user variable ) USERV.DSP ENDOF VAR.ADR OF ( display a global variable ) VAR.DSP ENDOF CONST.ADR OF ( display a compiled constant ) CONST.DSP ENDOF PSCODE.ADR OF ( display ;CODE and quit ) WORD.PTR @ @ WORD.DSP 1 QUIT.FLAG ! ENDOF DUP 63255 = IF 1 QUIT.FLAG ! THEN ( all special word types checked, ) DUP WORD.DSP ( if word did not match any cases ) ( just print it's name ) ENDCASE CR ( done decoding word type ) 2 WORD.PTR +! ( update pseudocode pointer ) QUIT.FLAG @ ( check if finished flag set or if ) ?TERMINAL OR ( interruption from terminal ) UNTIL ( otherwise display another word ) ENDIF CR ( all done now ) BASE ! ; : DLI -FIND 0= ( is input word in dictionary ? ) IF 3 SPACES ." ? not in glossary " CR ( no, quit ) ELSE DROP DECOMPILE THEN ; : VLI CONTEXT @ @ BEGIN DUP ID. 2 SPACES PFAPTR LFA @ DUP 0= ?TERMINAL OR UNTIL DROP ; : CFIND CONTEXT @ @ BEGIN SWAP DUP ROT DUP PFAPTR CFA ROT = IF CR ID. 1 ELSE PFAPTR LFA @ DUP 0= IF DROP ." not found " 1 ELSE 0 THEN THEN ?TERMINAL OR UNTIL DROP ; : ADUMP 0 DO DUP I + C@ DUP IF > IF 2 SPACES EMIT ELSE 3 .R THEN LOOP DROP ; : DECOMPLIST ( name -- ) CR CR -FIND 0= IF 3 SPACES ." not in glossary " CR ELSE DROP NFA BEGIN DUP CR ID. PFAPTR DUP DECOMPILE CR LFA @ DUP 0= ?TERMINAL OR UNTIL DROP THEN ;