home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
source
/
dis5.seq
< prev
next >
Wrap
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