Power-Programmierung/CD1.mdf/forth/compiler/fpc/source/dis5.seq

Text File | 1990-12-17 | 9KB | 349 lines

\ 6805 Disassembler                                     Andrew McKewan


ONLY FORTH ALSO DEFINITIONS DECIMAL

\ : .ID|          ( nfa -- )  \ Print without trailing space
\                DUP 1+ DUP YC@ ROT YC@ 31 AND 0
\                ?DO     DUP 127 AND FEMIT 128 AND
\                        IF   ASCII _ 128 OR   ELSE  1+ DUP YC@  THEN
\                LOOP    2DROP ;


ASSEMBLER DEFINITIONS
DEFER T@        FORTH ' @       ASSEMBLER IS T@
FORTH DEFINITIONS


VOCABULARY DIS6805  DIS6805 ALSO DEFINITIONS

\ Target Memory Access
DEFER TC@       ASSEMBLER ' TC@      DIS6805 IS TC@
\ DEFER T@        ASSEMBLER ' T@       DIS6805 IS T@

: T@  ( tadr -- n )  DUP 1+ TC@  SWAP TC@  JOIN ;

variable CP
: nextb  ( -- b )  cp @ tc@  1 cp +! ;
: nextw  ( -- w )  cp @ t@   2 cp +! ;


\ Display hex object code

: ##    save> base hex  0 <# # #     #> type space  restore> base ;
: ####  save> base hex  0 <# # # # # #> type space  restore> base ;

: H.    save> base hex  0 <# #S #> TYPE  restore> base ;

: bytes  ( tadr n -- tadr )
   2 spaces  over + over do i tc@ ## loop ; \ *** TCOM
\   over #### space  over + over do i tc@ ## loop ;

: byte    1 bytes ;
: 2bytes  2 bytes ;
: 3bytes  3 bytes ;

: bit#  ( opcode -- bit# )  2/ 7 and ;
: B>W  ( byte -- n )  DUP 128 AND IF 256 - THEN ;


\ disassembly format:
\ AAAA XX XX XX       OPC     OPR     COMMENT

: tab #out @ - spaces ;
: opcode   20 tab ;
: operand  28 tab ;
: comment  36 tab ;

\ : op  create last @ ,  does> opcode @ .id|  1+ ;

: OP    >IN @ CREATE >IN ! BL WORD C@ 1+ ALLOT
        DOES> OPCODE COUNT TYPE 1+ ;
: opcodes  0 do  op  loop ;

3 opcodes BRSET BSET BCLR
8 opcodes NEG COM LSR ROR ASR LSL ROL DEC
8 opcodes INC TST CLR SUB CMP SBC CPX AND
8 opcodes BIT LDA STA EOR ADC ORA ADD JMP
3 opcodes JSR LDX STX

\ operands
( tadr -- tadr' )
: dir   operand  dup tc@ h. 1+ ;
: ext   operand  dup t@  h. 2+ ;
: imm   operand  ." #" dir ;
: ix    operand  ." ,X" ;
: ix1   dir ." ,X" ;
: ix2   ext ." ,X" ;
: rel   operand  dup 1+ swap tc@ b>w over + h. ;
: bsc   operand  dup 1- tc@ bit# h. ." ," dir ;
: btb   bsc ." ," rel ;
: inha  ." A" ;
: inhx  ." X" ;

\ opcode table
: illegal  byte  opcode  ." ???" 1+ ;

create map 512 allot
: >map 2* map + ;
: init  256 0 do  ['] illegal i >map !  loop ;
init forget init

: op:  ( n -- )
   >map here swap !
   233 c,  'docol here 2+ - ,
   xhere paragraph + dup xdpseg !
   xseg @ - ,  xdp off
   !csp  ] ;

: %inst   ( tadr -- tadr' )
   dup tc@ >map perform ;

: inst  cp @ %inst cp ! ;       \ *** TCOM


\ ****** INSTRUCTIONS ******

\ bit instructions

$00 op: 3 bytes  brset btb ;
$10 op: 2 bytes  bset  bsc ;
$11 op: 2 bytes  bclr  bsc ;

: init 0 >map @  $10 1 do  dup i >map !  loop  drop ;
init forget init

: init $10 >map 2@  $20 $12 do  2dup i >map 2!  2 +loop  2drop ;
init forget init

\ branches
: branch  >r >r  2 bytes  r> r> opcode type  1+ rel ;

$20 op: " BRA"  branch ;        $21 op: " BRN"  branch ;
$22 op: " BHI"  branch ;        $23 op: " BLS"  branch ;
$24 op: " BCC"  branch ;        $25 op: " BCS"  branch ;
$26 op: " BNE"  branch ;        $27 op: " BEQ"  branch ;
$28 op: " BHCC" branch ;        $29 op: " BHCS" branch ;
$2a op: " BPL"  branch ;        $2b op: " BMI"  branch ;
$2c op: " BMC"  branch ;        $2d op: " BMS"  branch ;
$2e op: " BIL"  branch ;        $2f op: " BIH"  branch ;
$ad op: " BSR"  branch ;

\ Unary instructions

$30 op: 2bytes neg dir ;
$40 op: byte   neg inha ;
$50 op: byte   neg inhx ;
$60 op: 2bytes neg ix1 ;
$70 op: byte   neg ix ;

$33 op: 2bytes com dir ;
$43 op: byte   com inha ;
$53 op: byte   com inhx ;
$63 op: 2bytes com ix1 ;
$73 op: byte   com ix ;

$34 op: 2bytes lsr dir ;
$44 op: byte   lsr inha ;
$54 op: byte   lsr inhx ;
$64 op: 2bytes lsr ix1 ;
$74 op: byte   lsr ix ;

$36 op: 2bytes ror dir ;
$46 op: byte   ror inha ;
$56 op: byte   ror inhx ;
$66 op: 2bytes ror ix1 ;
$76 op: byte   ror ix ;

$37 op: 2bytes asr dir ;
$47 op: byte   asr inha ;
$57 op: byte   asr inhx ;
$67 op: 2bytes asr ix1 ;
$77 op: byte   asr ix ;

$38 op: 2bytes lsl dir ;
$48 op: byte   lsl inha ;
$58 op: byte   lsl inhx ;
$68 op: 2bytes lsl ix1 ;
$78 op: byte   lsl ix ;

$39 op: 2bytes rol dir ;
$49 op: byte   rol inha ;
$59 op: byte   rol inhx ;
$69 op: 2bytes rol ix1 ;
$79 op: byte   rol ix ;

$3a op: 2bytes dec dir ;
$4a op: byte   dec inha ;
$5a op: byte   dec inhx ;
$6a op: 2bytes dec ix1 ;
$7a op: byte   dec ix ;

$3c op: 2bytes inc dir ;
$4c op: byte   inc inha ;
$5c op: byte   inc inhx ;
$6c op: 2bytes inc ix1 ;
$7c op: byte   inc ix ;

$3d op: 2bytes tst dir ;
$4d op: byte   tst inha ;
$5d op: byte   tst inhx ;
$6d op: 2bytes tst ix1 ;
$7d op: byte   tst ix ;

$3f op: 2bytes clr dir ;
$4f op: byte   clr inha ;
$5f op: byte   clr inhx ;
$6f op: 2bytes clr ix1 ;
$7f op: byte   clr ix ;

\ Inherant instructions

: inherant  byte opcode 1+ ;
$80 op: inherant ." RTI" ;
$81 op: inherant ." RTS" ;
$83 op: inherant ." SWI" ;
$8e op: inherant ." STOP" ;
$8f op: inherant ." WAIT" ;

$97 op: inherant ." TAX" ;
$98 op: inherant ." CLC" ;
$99 op: inherant ." SEC" ;
$9a op: inherant ." CLI" ;
$9b op: inherant ." SEI" ;
$9c op: inherant ." RSP" ;
$9d op: inherant ." NOP" ;
$9f op: inherant ." TXA" ;

\ Binary instructions

$a0 op: 2bytes sub imm ;
$b0 op: 2bytes sub dir ;
$c0 op: 3bytes sub ext ;
$d0 op: 3bytes sub ix2 ;
$e0 op: 2bytes sub ix1 ;
$f0 op: byte   sub ix ;

$a1 op: 2bytes cmp imm ;
$b1 op: 2bytes cmp dir ;
$c1 op: 3bytes cmp ext ;
$d1 op: 3bytes cmp ix2 ;
$e1 op: 2bytes cmp ix1 ;
$f1 op: byte   cmp ix ;

$a2 op: 2bytes sbc imm ;
$b2 op: 2bytes sbc dir ;
$c2 op: 3bytes sbc ext ;
$d2 op: 3bytes sbc ix2 ;
$e2 op: 2bytes sbc ix1 ;
$f2 op: byte   sbc ix ;

$a3 op: 2bytes cpx imm ;
$b3 op: 2bytes cpx dir ;
$c3 op: 3bytes cpx ext ;
$d3 op: 3bytes cpx ix2 ;
$e3 op: 2bytes cpx ix1 ;
$f3 op: byte   cpx ix ;

$a4 op: 2bytes and imm ;
$b4 op: 2bytes and dir ;
$c4 op: 3bytes and ext ;
$d4 op: 3bytes and ix2 ;
$e4 op: 2bytes and ix1 ;
$f4 op: byte   and ix ;

$a5 op: 2bytes bit imm ;
$b5 op: 2bytes bit dir ;
$c5 op: 3bytes bit ext ;
$d5 op: 3bytes bit ix2 ;
$e5 op: 2bytes bit ix1 ;
$f5 op: byte   bit ix ;

$a6 op: 2bytes lda imm ;
$b6 op: 2bytes lda dir ;
$c6 op: 3bytes lda ext ;
$d6 op: 3bytes lda ix2 ;
$e6 op: 2bytes lda ix1 ;
$f6 op: byte   lda ix ;

\ $a7 op: 2bytes sta imm ;
$b7 op: 2bytes sta dir ;
$c7 op: 3bytes sta ext ;
$d7 op: 3bytes sta ix2 ;
$e7 op: 2bytes sta ix1 ;
$f7 op: byte   sta ix ;

$a8 op: 2bytes eor imm ;
$b8 op: 2bytes eor dir ;
$c8 op: 3bytes eor ext ;
$d8 op: 3bytes eor ix2 ;
$e8 op: 2bytes eor ix1 ;
$f8 op: byte   eor ix ;

$a9 op: 2bytes adc imm ;
$b9 op: 2bytes adc dir ;
$c9 op: 3bytes adc ext ;
$d9 op: 3bytes adc ix2 ;
$e9 op: 2bytes adc ix1 ;
$f9 op: byte   adc ix ;

$aa op: 2bytes ora imm ;
$ba op: 2bytes ora dir ;
$ca op: 3bytes ora ext ;
$da op: 3bytes ora ix2 ;
$ea op: 2bytes ora ix1 ;
$fa op: byte   ora ix ;

$ab op: 2bytes add imm ;
$bb op: 2bytes add dir ;
$cb op: 3bytes add ext ;
$db op: 3bytes add ix2 ;
$eb op: 2bytes add ix1 ;
$fb op: byte   add ix ;

\ $ac op: 2bytes jmp imm ;
$bc op: 2bytes jmp dir ;
$cc op: 3bytes jmp ext ;
$dc op: 3bytes jmp ix2 ;
$ec op: 2bytes jmp ix1 ;
$fc op: byte   jmp ix ;

\ $ad op: 2bytes jsr imm ;
$bd op: 2bytes jsr dir ;
$cd op: 3bytes jsr ext ;
$dd op: 3bytes jsr ix2 ;
$ed op: 2bytes jsr ix1 ;
$fd op: byte   jsr ix ;

$ae op: 2bytes ldx imm ;
$be op: 2bytes ldx dir ;
$ce op: 3bytes ldx ext ;
$de op: 3bytes ldx ix2 ;
$ee op: 2bytes ldx ix1 ;
$fe op: byte   ldx ix ;

\ $af op: 2bytes stx imm ;
$bf op: 2bytes stx dir ;
$cf op: 3bytes stx ext ;
$df op: 3bytes stx ix2 ;
$ef op: 2bytes stx ix1 ;
$ff op: byte   stx ix ;


FORTH DEFINITIONS
: wait          key 27 = abort"  OK" ;
: start/stop    key? if wait wait then ;

: ndis  ( tadr #inst -- )
        0 do  start/stop  cr %inst  loop drop ;

: (dis) ( tadr -- )
        0 swap
        begin   cr 1 0 d+ over 10 mod 0=
                if ." More..." wait 7 backspaces then
                dup %inst swap tc@ $81 =
        until   2drop ;

ONLY FORTH ALSO DEFINITIONS