home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / dis.seq < prev    next >
Encoding:
Text File  |  1991-02-13  |  16.1 KB  |  476 lines
  1. \ DIS8086.SEQ   8086 Disassembler  by Charles Curley
  2. \ Prefix conversion by  Bill Muench  9 September 88
  3. \ conversion to TCOM and symbolic additions by Tom Zimmer  03/07/90
  4. \ conversion to 6805 by Andrew McKewan 12/17/90
  5.  
  6. comment:
  7.  
  8.   A disassembler, for taking apart .COM files built by TCOM. This
  9. program reads a file.COM and its .SYM (symbol) and .LIN (line table)
  10. files, then proceeds to disassemble to the display with symbols and
  11. source. I/O redirection is supported for output, with the normal DOS
  12. ">" symbol. Only the CODE portion of the file is disassembled.
  13.  
  14.         USAGE:  DIS CLOCK TIK/TOK >CLOCK.LST  [Enter]
  15.  
  16.   This will disassemble CLOCK.COM, using CLOCK.SYM and CLOCK.LIN to
  17. provide symbols and source for the disassembly. Disassembly will start
  18. at symbol "TIK/TOK" if it is found in the symbol table file. Output
  19. will be directed to the file CLOCK.LST.
  20.  
  21.   If the .SYM or .LIN file is not available, disassembly continues
  22. without symbols or source. If NON-TCOM files are disassembled, DIS will
  23. not know how much of the file to disassemble, but will proceed anyway
  24. until terminated or until what it thinks is the end of file is reached.
  25. If no symbol is specified, or the specified symbol is not found, then
  26. disassembly starts at HEX 100.
  27.  
  28.   Disassembly with symbols and source is a relatively slow process, so
  29. if you redirect output to a file, be prepared to wait upto several
  30. minutes for the disassembly to complete.  The file created by DIS with
  31. I/O redirection are usually fairly large, so make sure you have lots of
  32. disk space. I ran DIS on the SZ editor, and created a file SZ.LST that
  33. was over 600k bytes long. It took six minutes to complete on a 20mhz
  34. 80386 machine.
  35.  
  36. comment;
  37.  
  38. : COL ( n ) #OUT @ - SPACES ;
  39.  
  40. VARIABLE DISSEG
  41.  
  42. : =SEG ( seg ) DISSEG ! ;
  43.  
  44. : 2/S           ( n ct - n'| shift n right ct )
  45.                 0 ?DO U2/ LOOP ;
  46.  
  47. : 2*S           ( n ct - n' | shift n left ct )
  48.                 0 ?DO 2* LOOP ;
  49.  
  50. CODE SEXT       ( n - n' | sign extend byte to word )
  51.                 MOV AX, BX
  52.                 CBW
  53.                 MOV BX, AX
  54.                 RET             END-CODE
  55.  
  56. VARIABLE RELOC    \ Relocation factor for dump or dis ???
  57. 0 RELOC !
  58.  
  59. : +RELOC        ( a - seg ofs ) RELOC @ + DISSEG @ SWAP ;
  60.  
  61. : T@            ( a - w ) +RELOC @L FLIP ;
  62. : TC@           ( a - n ) +RELOC C@L ;
  63.  
  64. : ID.L ( a ) #OUT @ SWAP count type #OUT @ - 6 + SPACES ;
  65.  
  66. :: SELF.L       ( Left Justified Self-doc! )
  67.                 CREATE DOES> ID.L ;
  68.  
  69. :: .SELF        ( Self-doc! )
  70.                 CREATE DOES> COUNT TYPE ;
  71.  
  72. VARIABLE CP
  73.  
  74. : NEXTB         ( - n ) CP @ TC@ 1 CP +! ;
  75. : NEXTW         ( - w ) CP @ T@  2 CP +! ;
  76.  
  77. \ Display hex object code
  78.  
  79. : H.    SAVE> BASE HEX  0 U.R  RESTORE> BASE ;
  80. : ##    save> base hex  0 <# # #     #> type space  restore> base ;
  81. : ####  save> base hex  0 <# # # # # #> type space  restore> base ;
  82.  
  83. : bytes  ( tadr n -- tadr )
  84.    2 spaces  over + over do i tc@ ## loop ; \ *** TCOM
  85. \   over #### space  over + over do i tc@ ## loop ;
  86.  
  87. : byte    1 bytes ;
  88. : 2bytes  2 bytes ;
  89. : 3bytes  3 bytes ;
  90.  
  91. : bit#  ( opcode -- bit# )  2/ 7 and ;
  92. : B>W  ( byte -- n )  DUP 128 AND IF 256 - THEN ;
  93.  
  94.  
  95. \ disassembly format:
  96. \ AAAA XX XX XX       OPC     OPR     COMMENT
  97.  
  98. \ : tab #out @ - spaces ;
  99. \ : opcode   20 tab ;
  100. \ : operand  28 tab ;
  101. \ : comment  36 tab ;
  102.  
  103. : >address      0 col ;
  104. : >object       0 col ;
  105. : >label        0 col ;
  106. : >opcode       0 col ;
  107. : >operand      22 col ;
  108.  
  109.  
  110. .self ??? ," ???"
  111.  
  112. .self NEG ," NEG"       .self COM ," COM"       .self LSR ," LSR"
  113. .self ROR ," ROR"       .self ASR ," ASR"       .self LSL ," LSL"
  114. .self ROL ," ROL"       .self DEC ," DEC"       .self INC ," INC"
  115. .self TST ," TST"       .self CLR ," CLR"       .self SUB ," SUB"
  116. .self CMP ," CMP"       .self SBC ," SBC"       .self CPX ," CPX"
  117. .self UND ," AND"       .self BIT ," BIT"       .self LDA ," LDA"
  118. .self STA ," STA"       .self EOR ," EOR"       .self ADC ," ADC"
  119. .self ORA ," ORA"       .self ADD ," ADD"       .self JMP ," JMP"
  120. .self JSR ," JSR"       .self LDX ," LDX"       .self STX ," STX"
  121.  
  122. .self BRA ," BRA"       .self BRN ," BRN"       .self BHI ," BHI"
  123. .self BLS ," BLS"       .self BCC ," BCC"       .self BCS ," BCS"
  124. .self BNE ," BNE"       .self BEQ ," BEQ"       .self BHCC ," BHCC"
  125. .self BHCS ," BHCS"     .self BPL ," BPL"       .self BMI ," BMI"
  126. .self BMC ," BMC"       .self BMS ," BMS"       .self BIL ," BIL"
  127. .self BIH ," BIH"
  128.  
  129. defer .symbol   ( adr -- )  \ display symbol or hex address
  130.  
  131. \ address modes:
  132.  
  133. : dir   nextb .symbol ;
  134. : ext   nextw .symbol ;
  135. : imm   ." #" dir ;
  136. : ix    ." ,X" ;
  137. : ix1   dir ." ,X" ;
  138. : ix2   ext ." ,X" ;
  139. : rel   nextb b>w cp @ + .symbol ;
  140. : bsc   cp @ 1- tc@ bit# 0 .r ." ," dir ;
  141. : btb   bsc ." ," rel ;
  142. : inha  ." A" ;
  143. : inhx  ." X" ;
  144.  
  145.  
  146. : .brset  ( opcode -- )
  147.         dup 1 and if ." BRCLR" else ." BRSET" then
  148.         >operand btb ;
  149.  
  150. : .bset  ( opcode -- )
  151.         dup 1 and if ." BCLR" else ." BSET" then
  152.         >operand bsc ;
  153.  
  154. : .bop   ( opcode -- )
  155.         15 and exec: bra brn bhi bls bcc bcs bne beq
  156.                      bhcc bhcs bpl bmi bmc bms bil bih ;
  157.  
  158. : .bran  ( opcode -- )
  159.         .bop >operand rel ;
  160.  
  161.  
  162. : op1  ( opcode -- )
  163.         15 and exec: sub cmp sbc cpx und bit lda sta
  164.                      eor adc ora add jmp jsr ldx stx ;
  165.  
  166. : mode1  ( mode -- )
  167.         10 - 5 min exec: imm dir ext ix2 ix1 ix ;
  168.  
  169. : arith  ( opcode mode -- )
  170.         over $ad = if drop ." BSR" >operand rel exit then
  171.         swap op1 >operand mode1 ;
  172.  
  173.  
  174. : op2  ( opcode -- )
  175.         15 and exec: neg ??? ??? com lsr ??? ror asr
  176.                      lsl rol dec ??? inc tst ??? clr ;
  177.  
  178. : mode2  ( mode -- )
  179.         3 - 4 min
  180.         dup 1 2 between not if >operand then
  181.         exec: dir inha inhx ix1 ix ;
  182.  
  183. : rmw   ( opcode mode -- )
  184.         over $42 = if ." MUL " 2drop exit then
  185.         swap op2 mode2 ;
  186.  
  187. : misc  ( opcode -- )
  188.         case
  189.         $80 of ." RTI"  endof           $81 of ." RTS"  endof
  190.         $83 of ." SWI"  endof           $8e of ." STOP" endof
  191.         $8f of ." WAIT" endof           $97 of ." TAX"  endof
  192.         $98 of ." CLC"  endof           $99 of ." SEC"  endof
  193.         $9a of ." CLI"  endof           $9b of ." SEI"  endof
  194.         $9c of ." RSP"  endof           $9d of ." NOP"  endof
  195.         $9f of ." TXA"  endof
  196.         ??? drop endcase ;
  197.  
  198.  
  199. : .inst ( op -- )
  200.         dup 16 /
  201.         dup 0= if drop .brset exit then
  202.         dup 1 = if drop .bset exit then
  203.         dup 2 = if drop .bran exit then
  204.         dup 3 7 between if rmw exit then
  205.         dup 8 9 between if drop misc exit then
  206.         arith ;
  207.  
  208.  
  209. : INST          \ display opcode at ip  advancing as needed
  210.                 save> base hex
  211.                 CP @ 0 <# # # # # #> TYPE 4 SPACES
  212.                 CP @ >R
  213.                 #OUT @ >R
  214.                 NEXTB .INST
  215. \                OPS @ CP +!
  216.                 R> #OUT @ - 28 + 1 max SPACES
  217.                 R> CP @ SWAP
  218.                 ?DO     I TC@ 0 <# # # #> TYPE
  219.                 LOOP
  220. \                OPS OFF
  221. \                DISP OFF
  222.                 restore> base ;
  223.  
  224.   15000 constant symmax
  225.       0 value    symbuf
  226.       0 value    symcnt
  227.       0 value    symptr
  228.         handle   symhndl
  229.       0 value    comseg
  230.       0 value    comcnt
  231.  
  232. : read_sym      ( -- )
  233.                 bl word symhndl $>handle
  234.                 " SYM" ">$ symhndl $>ext
  235.                 symhndl hopen
  236.                 if      cr ." Could not open " symhndl count type
  237.                         ." , no symbols available."
  238.                         off> symcnt symbuf off exit
  239.                 then    cr ." Opened " symhndl count type ." , read "
  240.                 symbuf symmax symhndl hread dup =: symcnt
  241.                 U. ." bytes"
  242.                 symhndl hclose drop ;
  243.  
  244. : .disusage     ( -- )
  245.                 cr ." Could not open " symhndl count type
  246.                 cr cr
  247.                 ." Usage: DIS <filename> <starting_symbol> <enter>"
  248.                 cr ." leaving" abort ;
  249.  
  250. : read_com      ( -- )          \ assumes symbol file has been read
  251.                 " BIN" ">$ symhndl $>ext
  252.                 symhndl hopen if .disusage then
  253.                 $1000 alloc 8 =                 \ allocate some space for
  254.                                                 \ the .COM file.
  255.                 if      cr ." Not enough memory, leaving" abort
  256.                 then    =: comseg drop
  257.                 cr ." Opened " symhndl count type ." , read "
  258.                 0 $2000 symhndl comseg exhread dup =: comcnt
  259.                 u. ." bytes"
  260.                 symhndl hclose drop ;
  261.  
  262. : %?symbol      ( a1 -- <a2 n1> f1 )    \ given a1 the symbol address, return
  263.                                         \ a2 n1 f1 = true if symbol found
  264.                                         \ else f1 false symbol not found
  265.                 0 <# # # # # #> drop =: symptr
  266.                 symbuf symcnt
  267.                 begin   over symptr 4 comp over 0> and
  268.                 while   $0A scan 1 /string
  269.                 repeat  dup
  270.                 if      2dup $0A scan nip -     \ parse line
  271.                         bl scan bl skip         \ remove leading number
  272.                         1- 0max
  273.                         over dup c@ $7F and swap c!
  274.                         true                    \ remove trailing CR
  275.                 else    2drop false
  276.                 then    ;
  277.  
  278. defer ?symbol
  279.  
  280. : ?.symbol      ( a1 -- )
  281.                 dup ?symbol
  282.                 if      type
  283.                 else    dup 0 U.R ( H. )
  284.                 then    drop ;
  285.  
  286. : show_symbol   ( -- <a2 n1> f1 )
  287.                 cp @ ?symbol ;
  288.  
  289. : ?address      ( a1 -- <a2> f1 )       \ given a1 the symbol name, return
  290.                                         \ a2 addr, & f1 = true if addr found
  291.                                         \ else f1 false addr not found
  292.                 ?uppercase =: symptr
  293.                 symptr c@ dup 0= ?exit drop
  294.                 symptr number? nip      \ pass in a number directly
  295.                 if      true exit
  296.                 then    drop
  297.                 $0D symptr count + c!
  298.                 symbuf symcnt
  299.                 begin   over 5 + symptr count 1+ caps-comp over 0> and
  300.                 while   $0A scan 1 /string
  301.                 repeat  dup
  302.                 if      2dup bl scan nip -     \ parse line
  303.                         here place
  304.                         bl here count + c!
  305.                         here number? nip
  306.                 else    2drop false
  307.                 then    ;
  308.  
  309. 0 value linseg
  310. 0 value lincnt
  311. 0 value linstart
  312. 0 value srcline
  313. 0 value targaddr
  314. 0 value ?src
  315. 80 array sline_buf
  316.  
  317.  
  318. : read_lin      ( -- )
  319.                 " LIN" ">$ symhndl $>ext
  320.                 symhndl hopen
  321.                 if      cr ." Could not open " symhndl count type
  322.                         exit
  323.                 then
  324.                 $1000 alloc 8 =                 \ allocate some space for
  325.                                                 \ the .COM file.
  326.                 if      cr ." Not enough memory, leaving" abort
  327.                 then    =: linseg drop
  328.                 cr ." Opened " symhndl count type ." , read "
  329.                 $00 $FF00 symhndl linseg exhread dup =: lincnt
  330.                 u. ." bytes"
  331.                 symhndl hclose drop ;
  332.  
  333. : getsline      ( -- f1 )
  334.                 linseg save!> sseg
  335.                 linstart lincnt 2dup $0A scan
  336.                 2dup 1 /string =: lincnt =: linstart
  337.                 nip - 79 min >r linseg swap ?ds: sline_buf 1+ r@ cmovel
  338.                 r> sline_buf c!
  339.                 restore> sseg
  340.                 sline_buf c@ 0= ?dup ?exit      \ stop if at end of lines
  341.                 sline_buf count 2dup bl scan 2dup 2>r nip - here place
  342.                 bl here count + c!
  343.                 here number? 2drop =: targaddr
  344.                 2r> bl skip 2dup $0D scan nip - dup
  345.                 if      here place
  346.                         bl here count + c!
  347.                         lreadhndl hclose drop
  348.                         here lreadhndl $>handle
  349.                         lreadhndl hopen         ( -- f1 )
  350.                         ibreset
  351.                 else    2drop false
  352.                 then    ;
  353.  
  354. : .source_line  ( -- )
  355.                 save> base decimal
  356.                 loadline @ 5 .r space
  357.                 lineread count 2- 0max type cr
  358.                 restore> base ;
  359.  
  360. : show_source   ( -- )
  361.                 ?src 0= ?exit
  362.                 begin   cp @ targaddr u>=
  363.                 while   .source_line
  364.                         getsline
  365.                         if      -1 =: targaddr
  366.                                 off> ?src
  367.                         then
  368.                         ?keypause
  369.                 repeat  ;
  370.  
  371. : skip_source   ( -- )
  372.                 ?src 0= ?exit
  373.                 begin   cp @ $10 - targaddr u>=
  374.                 while   lineread drop
  375.                         getsline
  376.                         if      -1 =: targaddr
  377.                                 off> ?src
  378.                         then
  379.                         ?keypause
  380.                 repeat  ;
  381.  
  382. : DIS           ( a1 -- )       \ disassemble from address a1
  383.                 cp ! ?cs: =seg
  384.                 begin   cr
  385.                         show_symbol
  386.                         if ." ; " type cr then
  387.                         8 spaces
  388.                         INST
  389.                         ?KEYPAUSE
  390.                 again   cr ;
  391.  
  392. [FORTH] ?DIS 0= [TARGET]        \ If we are not just appending disassembler
  393. #IF                             \ but are actually building a standalone
  394.                                 \ disassembler, then include this
  395.  
  396. : show-variables
  397.                 save> base hex
  398.                 $100 0
  399.         do      i ?symbol
  400.                 if      cr 8 spaces
  401.                         i 0 <# # # # # #> type
  402.                         2 spaces type
  403.                 then
  404.         loop    cr
  405.                 restore> base ;
  406.  
  407.  
  408. : .1inst_line   ( -- )
  409.                 CR
  410.                 show_source
  411.                 show_symbol
  412.                 if ." ; " type cr then
  413.                 8 spaces
  414.                 INST ;
  415.  
  416. : .VECTOR       ( addr - )
  417.                 CR DUP 12 .R
  418.                 4 SPACES ." FDB"
  419.                 3 SPACES T@ .SYMBOL ;
  420.  
  421. : SHOW-VECTORS  ( -- )
  422.                 SAVE> BASE HEX
  423.                 $2000 $1FF4
  424.                 DO      I .VECTOR
  425.              2 +LOOP
  426.                 RESTORE> BASE ;
  427.  
  428. VARIABLE CPEND
  429. : find-cpend    ( -- )
  430.                 $10ff
  431.                 begin   dup tc@ 0=  over $101 u> and
  432.                 while   1-
  433.                 repeat  cpend ! ;
  434.  
  435. : DISASSEM      ( -- )
  436.                 CAPS ON
  437.                 ?ds: sseg !
  438.                 DOSIO_INIT                      \ init EMIT, TYPE & SPACES
  439.                 symmax 2+ ds:alloc =: symbuf
  440.                 $FFF0 SET_MEMORY                \ default to 64k code space
  441.                 DOS_TO_TIB                      \ move command tail to TIB
  442.                 DECIMAL
  443.                 lineread_init
  444.                 ['] ?.symbol is .symbol
  445.                 ['] %?symbol is ?symbol
  446.                 read_sym                        \ read symbol table
  447.                 read_com                        \ read .COM file
  448.                 read_lin
  449.                 getsline dup 0= =: ?src
  450.                 if      cr ." Could not open source file"
  451.                 then
  452.                 comseg =SEG
  453.                 HEX
  454.                 cr
  455.                 bl word ?address        \ find word following, if found
  456.                 if      cp !            \ set as starting address
  457.                         skip_source     \ walk past previous source lines
  458.                 else    $100 cp !       \ else use $100 for starting
  459.                 then
  460. \                symcnt                  \ if symbol file presend,
  461. \                if      comseg $0103 @L $10 *   \ then assume its a TCOM file
  462. \                else    $FF00                   \ else just do whole .COM file
  463. \                then comcnt cp @ + umin cpend !
  464.                 find-cpend
  465.                 show-variables
  466.                 BEGIN   .1inst_line
  467.                         ?KEYPAUSE
  468.                         CP @ CPEND @ U>
  469.                 UNTIL
  470.                 CR CR
  471.                 SHOW-VECTORS
  472.                 cr cr ;
  473.  
  474. #ENDIF
  475.  
  476.