home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / disevm.seq < prev    next >
Encoding:
Text File  |  1991-01-06  |  6.2 KB  |  199 lines
  1. \ DISEVM.SEQ            6805 EVM Disassembler           by Andrew McKewan
  2.  
  3. \ From DIS8086 by Charles Curley
  4. \ Prefix conversion by  Bill Muench  9 September 88
  5. \ conversion to TCOM and symbolic additions by Tom Zimmer  03/07/90
  6. \ conversion to 6805 by Andrew McKewan 12/17/90
  7.  
  8.  
  9. ONLY FORTH ALSO DEFINITIONS
  10.  
  11. : .ID|          ( nfa -- )      \ Display name without trailing space
  12.                 DUP 1+ DUP YC@ ROT YC@ 31 AND 0
  13.                ?DO      DUP 127 AND FEMIT 128 AND
  14.                         IF   ASCII _ 128 OR   ELSE  1+ DUP YC@  THEN
  15.                 LOOP    2DROP ;
  16.  
  17. : .ID|N         ( nfa n -- )      \ Display name max n characters
  18.                 >r  DUP 1+ DUP YC@ ROT YC@ 31 AND  r> min  0
  19.                ?DO      DUP 127 AND FEMIT 128 AND
  20.                         IF   ASCII _ 128 OR   ELSE  1+ DUP YC@  THEN
  21.                 LOOP    2DROP ;
  22.  
  23. : COL ( n ) #OUT @ - SPACES ;
  24.  
  25. VOCABULARY DISASSEMBLER   DISASSEMBLER DEFINITIONS
  26.  
  27. DEFER TC@       ' C@ IS TC@     \ fetch target memory byte
  28. DEFER T@        ' @ IS T@       \ fetch target memory word
  29.  
  30. DEFER ?SYMBOL   ( adr -- nfa t | f )      \ find symbol
  31.  
  32. : no  drop false ;  ' no is ?symbol
  33.  
  34. : .symbol       ( a1 -- )       \ display symbol or address
  35.                 dup ?symbol
  36.                 if      .id|
  37.                         ."  [" 0 .r ." ]"
  38.                 else    0 u.r
  39.                 then    ;
  40.  
  41. : nextb     ( a1 -- a2 n )  dup 1+  swap tc@ ;
  42. : nextw     ( a1 -- a2 w )  dup 2+  swap t@ ;
  43.  
  44. : bit#  ( opcode -- bit# )  2/ 7 and ;
  45. : b>w   ( byte -- n )  dup 128 and if 256 - then ;
  46.  
  47. comment:
  48. \ disassembly format:
  49. \           1         2         3         4
  50. \ 01234567890123456789012345678901234567890123456789
  51. \ AAAA  LABEL       OPC   OPERAND         OBJECT
  52.  
  53. : column ( col ) create , does> @ col ;  \ modify with =:
  54.  
  55.  0 column >address       \ column for address display
  56.  6 column >label         \ column for label display
  57. 18 column >opcode        \ column for opcode display
  58. 24 column >operand       \ column for operand display
  59. 40 column >object        \ column for object code display
  60.  
  61.  
  62. : .address      ( adr -- )
  63.                 >address
  64.                 0 <# # # # # #> type ;
  65.  
  66. : .label        ( adr -- )
  67.                 >label
  68.                 ?symbol
  69.                 if      10 .id|n
  70.                 then ;
  71.  
  72. : .object       ( end start -- )
  73.                 >object
  74.                 ?do     i tc@ 0 <# # # #> type
  75.                 loop ;
  76. comment;
  77.  
  78.  
  79. 6 value opwid   \ width of opcode field
  80. 0 value out0    \ #out at beginning of opcode
  81.  
  82. : >op           \ go to operand field
  83.                 out0 opwid +  #out @ -  spaces ;
  84.  
  85. : .SELF         ( Self-doc! )
  86.                 CREATE DOES> COUNT TYPE ;
  87.  
  88. .self ??? ," ???"
  89.  
  90. .self NEG ," NEG"       .self COM ," COM"       .self LSR ," LSR"
  91. .self ROR ," ROR"       .self ASR ," ASR"       .self LSL ," LSL"
  92. .self ROL ," ROL"       .self DEC ," DEC"       .self INC ," INC"
  93. .self TST ," TST"       .self CLR ," CLR"       .self SUB ," SUB"
  94. .self CMP ," CMP"       .self SBC ," SBC"       .self CPX ," CPX"
  95. .self UND ," AND"       .self BIT ," BIT"       .self LDA ," LDA"
  96. .self STA ," STA"       .self EOR ," EOR"       .self ADC ," ADC"
  97. .self ORA ," ORA"       .self ADD ," ADD"       .self JMP ," JMP"
  98. .self JSR ," JSR"       .self LDX ," LDX"       .self STX ," STX"
  99.  
  100. .self BRA ," BRA"       .self BRN ," BRN"       .self BHI ," BHI"
  101. .self BLS ," BLS"       .self BCC ," BCC"       .self BCS ," BCS"
  102. .self BNE ," BNE"       .self BEQ ," BEQ"       .self BHCC ," BHCC"
  103. .self BHCS ," BHCS"     .self BPL ," BPL"       .self BMI ," BMI"
  104. .self BMC ," BMC"       .self BMS ," BMS"       .self BIL ," BIL"
  105. .self BIH ," BIH"
  106.  
  107. \ Address Modes
  108.  
  109. : dir   ( a1 -- a2 )      nextb .symbol ;
  110. : ext   ( a1 -- a2 )      nextw .symbol ;
  111. : imm   ( a1 -- a2 )      ." #" dir ;
  112. : ix    ( a1 -- a2 )      ." ,X" ;
  113. : ix1   ( a1 -- a2 )      dir ." ,X" ;
  114. : ix2   ( a1 -- a2 )      ext ." ,X" ;
  115. : rel   ( a1 -- a2 )      nextb b>w over + .symbol ;
  116. : bsc   ( a1 op -- a2 )   bit# 0 .r ." ," dir ;
  117. : btb   ( a1 op -- a2 )   bsc ." ," rel ;
  118. : inha  ( -- )            ." A" ;
  119. : inhx  ( -- )            ." X" ;
  120.  
  121. \ Opcode Types
  122.  
  123. : .brset  ( a1 opcode -- a2 )
  124.         dup 1 and if ." BRCLR" else ." BRSET" then  >op btb ;
  125.  
  126.  
  127. : .bset  ( a1 opcode -- a2 )
  128.         dup 1 and if ." BCLR" else ." BSET" then  >op bsc ;
  129.  
  130.  
  131. : .bop  ( opcode -- )
  132.         15 and exec: bra brn bhi bls bcc bcs bne beq
  133.                      bhcc bhcs bpl bmi bmc bms bil bih ;
  134.  
  135. : .bran  ( a1 opcode -- a2 )
  136.         .bop >op rel ;
  137.  
  138.  
  139. : op1  ( opcode -- )
  140.         15 and exec: sub cmp sbc cpx und bit lda sta
  141.                      eor adc ora add jmp jsr ldx stx ;
  142.  
  143. : mode1  ( a1 mode -- a2 )
  144.         10 - 5 min exec: imm dir ext ix2 ix1 ix ;
  145.  
  146. : arith  ( a1 opcode mode -- a2 )
  147.         over $ad = if  2drop ." BSR" >op rel exit  then
  148.         swap op1 >op mode1 ;
  149.  
  150.  
  151. : op2  ( opcode -- )
  152.         15 and exec: neg ??? ??? com lsr ??? ror asr
  153.                      lsl rol dec ??? inc tst ??? clr ;
  154.  
  155. : mode2  ( a1 mode -- a2 )
  156.         3 - 4 min
  157.         dup 1 2 between ( inherant ) not if >op then
  158.         exec: dir inha inhx ix1 ix ;
  159.  
  160. : rmw   ( a1 opcode mode -- a2 )
  161.         over $42 = if ." MUL" 2drop exit then
  162.         swap op2 mode2 ;
  163.  
  164.  
  165. : misc  ( opcode -- )
  166.         case
  167.         $80 of ." RTI"  endof           $81 of ." RTS"  endof
  168.         $83 of ." SWI"  endof           $8e of ." STOP" endof
  169.         $8f of ." WAIT" endof           $97 of ." TAX"  endof
  170.         $98 of ." CLC"  endof           $99 of ." SEC"  endof
  171.         $9a of ." CLI"  endof           $9b of ." SEI"  endof
  172.         $9c of ." RSP"  endof           $9d of ." NOP"  endof
  173.         $9f of ." TXA"  endof
  174.         ??? drop endcase ;
  175.  
  176.  
  177. : .inst ( a1 opcode -- a2 )     \ Display one instruction
  178.         dup 16 /
  179.         dup 0=  if drop .brset exit then
  180.         dup 1 = if drop .bset exit then
  181.         dup 2 = if drop .bran exit then
  182.         dup 3 7 between if rmw exit then
  183.         dup 8 9 between if drop misc exit then
  184.         arith ;
  185.  
  186.  
  187. ONLY FORTH ALSO DEFINITIONS
  188.  
  189. : INST  ( a1 -- a2 )    \ display opcode, advancing address as needed
  190.         [ disassembler ]
  191.         #out @ =: out0
  192.         nextb .inst ;
  193.  
  194. : DIS   ( a n -- )
  195.         0 ?do cr inst loop drop ;
  196.  
  197.  
  198.  
  199.