home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_5.ZIP / TCOMUTIL.ZIP / DIS.SEQ next >
Encoding:
Text File  |  1991-04-15  |  28.4 KB  |  814 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.  
  5. comment:
  6.  
  7.   A disassembler, for taking apart .COM files built by TCOM. This
  8. program reads a file.COM and its .SYM (symbol) and .LIN (line table)
  9. files, then proceeds to disassemble to the display with symbols and
  10. source. I/O redirection is supported for output, with the normal DOS
  11. ">" symbol. Only the CODE portion of the file is disassembled.
  12.  
  13.         USAGE:  DIS CLOCK TIK/TOK >CLOCK.LST  [Enter]
  14.  
  15.   This will disassemble CLOCK.COM, using CLOCK.SYM and CLOCK.LIN to
  16. provide symbols and source for the disassembly. Disassembly will start
  17. at symbol "TIK/TOK" if it is found in the symbol table file. Output
  18. will be directed to the file CLOCK.LST.
  19.  
  20.   If the .SYM or .LIN file is not available, disassembly continues
  21. without symbols or source. If NON-TCOM files are disassembled, DIS will
  22. not know how much of the file to disassemble, but will proceed anyway
  23. until terminated or until what it thinks is the end of file is reached.
  24. If no symbol is specified, or the specified symbol is not found, then
  25. disassembly starts at HEX 100.
  26.  
  27.   Disassembly with symbols and source is a relatively slow process, so
  28. if you redirect output to a file, be prepared to wait upto several
  29. minutes for the disassembly to complete.  The file created by DIS with
  30. I/O redirection are usually fairly large, so make sure you have lots of
  31. disk space. I ran DIS on the SZ editor, and created a file SZ.LST that
  32. was over 600k bytes long. It took six minutes to complete on a 20mhz
  33. 80386 machine.
  34.  
  35. comment;
  36.  
  37. : COL ( n ) #OUT @ - SPACES ;
  38.  
  39. VARIABLE DISSEG
  40.  
  41. : =SEG ( seg ) DISSEG ! ;
  42.  
  43. : 2/S           ( n ct - n'| shift n right ct )
  44.                 0 ?DO U2/ LOOP ;
  45.  
  46. : 2*S           ( n ct - n' | shift n left ct )
  47.                 0 ?DO 2* LOOP ;
  48.  
  49. CODE SEXT       ( n - n' | sign extend byte to word )
  50.                 MOV AX, BX
  51.                 CBW
  52.                 MOV BX, AX
  53.                 RET             END-CODE
  54.  
  55. VARIABLE RELOC    \ Relocation factor for dump or dis ???
  56. 0 RELOC !
  57.  
  58. : +RELOC        ( a ) RELOC @ + DISSEG @ SWAP ;
  59.  
  60. : T@            ( a - w ) +RELOC @L ;
  61. : TC@           ( a - n ) +RELOC C@L ;
  62.  
  63. : .#            ( -- ) ." # " ;
  64.  
  65. : .,            ( -- ) ." , " ;
  66.  
  67. : ?.,           ( op - op ) DUP $0C7 AND 6 <> IF ., THEN ;
  68.  
  69. : .FAR          ( -- ) ." FAR " ;
  70.  
  71. : ID.L ( a ) #OUT @ SWAP count type #OUT @ - 6 + SPACES ;
  72.  
  73. :: SELF.L       ( Left Justified Self-doc! )
  74.                 CREATE DOES> ID.L ;
  75.  
  76. :: .SELF        ( Self-doc! )
  77.                 CREATE DOES> COUNT TYPE ;
  78.  
  79. VARIABLE CP
  80.  
  81. : NEXTB         ( - n ) CP @ TC@ 1 CP +! ;
  82. : NEXTW         ( - w ) CP @ T@  2 CP +! ;
  83.  
  84. : .NA           ( n ) ."   ??? " H. ;
  85. : .NA0          ( n - n ) DUP .NA ;
  86. : .NA1          ( op ext ) SWAP .NA H. ;
  87.  
  88. VARIABLE OPS    \ operand count
  89. VARIABLE DISP   \ 2nd operand ext, flag, ct
  90.  
  91. : ?DISP         ( op ext - op ext | ?MOD disp )
  92.                 DUP 6 2/S ?DUP 0=
  93.                 IF ( MOD=0 ) DUP 7 AND ( ?R/M ) 6 = 2 AND
  94.                 THEN DUP 3 = IF ( MOD=3 ) DROP 0 THEN DISP ! ;
  95.  
  96. .SELF AL_ ," AL"  .SELF AX_   ," AX"   .SELF [BX+SI]_  ," [BX+SI]"
  97. .SELF CL_ ," CL"  .SELF CX_   ," CX"   .SELF [BX+DI]_  ," [BX+DI]"
  98. .SELF DL_ ," DL"  .SELF DX_   ," DX"   .SELF [BP+SI]_  ," [BP+SI]"
  99. .SELF BL_ ," BL"  .SELF BX_   ," BX"   .SELF [BP+DI]_  ," [BP+DI]"
  100. .SELF AH_ ," AH"  .SELF SP_   ," SP"   .SELF [SI]_     ," [SI]"
  101. .SELF CH_ ," CH"  .SELF BP_   ," BP"   .SELF [DI]_     ," [DI]"
  102. .SELF DH_ ," DH"  .SELF SI_   ," SI"   .SELF [BP]_     ," [BP]"
  103. .SELF BH_ ," BH"  .SELF DI_   ," DI"   .SELF [BX]_     ," [BX]"
  104. .SELF RP_ ," RP"  .SELF [RP]_ ," [RP]"    \ Return Stack Pointer
  105. .SELF IP_ ," IP"  .SELF [IP]_ ," [IP]"    \ Interpreter Pointer
  106. .SELF ES_ ," ES"
  107. .SELF CS_ ," CS"
  108. .SELF SS_ ," SS"
  109. .SELF DS_ ," DS"
  110.  
  111. DEFER .SYMBOL
  112.  
  113. .SELF BYTE_ ," BYTE"
  114. .SELF WORD_ ," WORD"
  115.  
  116. : .SIZE         ( op ) 1 AND EXEC: BYTE_ WORD_ ;
  117.  
  118. : .8REG         ( ext )
  119.                 7 AND EXEC: AL_ CL_ DL_ BL_ AH_ CH_ DH_ BH_ ;
  120.  
  121. : .16REG        ( ext )
  122.                 7 AND EXEC: AX_ CX_ DX_ BX_ SP_ BP_ SI_ DI_ ;
  123.  
  124. : .R8/16        ( op ext )
  125.                 SWAP 1 AND EXEC: .8REG .16REG ;
  126.  
  127. : .R/M          ( op ext - op ext ) 2DUP .R8/16 ;
  128. : .REG          ( op ext - op ext ) 2DUP 3 2/S .R8/16 ;
  129.  
  130. : 0DISP         ." 0 " ;
  131.  
  132. : BDISP|        \ byte displacement
  133.                 CP @ DISP @ + TC@    1 OPS +! ;
  134.  
  135. : BDISP         \ byte displacement
  136.                 BDISP| SEXT . ;
  137.  
  138. : WDISP         \ word displacement
  139.                 CP @ DISP @ + T@ .SYMBOL 2 OPS +! ;
  140.  
  141. : .DISP         ( op ext - op ext )
  142.                 DUP 6 2/S 3 AND EXEC: 0DISP BDISP WDISP .R/M ;
  143.  
  144. : BIMM          ( byte immediate ) .# BDISP| . ;
  145. : WIMM          ( word immediate ) .# WDISP space ;
  146.  
  147. : .IMM          ( op ) 1 AND IF WIMM EXIT THEN BIMM ;
  148.  
  149. : .MREG         ( op ext - op ext | reg + disp )
  150.                 $0C0 2DUP AND = IF ( MOD=3 ) .R/M EXIT THEN
  151.                 DUP $0C7 AND 6 =
  152.                 IF ( MOD=0 R/M=6 )  ." [" WDISP ." ] " EXIT
  153.                 THEN  .DISP  DUP 7 AND ( MOD=1 or 2 )
  154.                 EXEC: [BX+SI]_  [BX+DI]_  [BP+SI]_  [BP+DI]_
  155.                       [SI]_     [DI]_     [BP]_     [BX]_ ;
  156.  
  157. : .SEG          ( op ) 3 2/S 3 AND EXEC: ES_ CS_ SS_ DS_ ;
  158.  
  159. : SEG:          ( op | segment override ) .SEG ." :" ;
  160.  
  161. : POP_          ( op ) DUP 15 = IF .NA EXIT THEN ." POP   " .SEG ;
  162. : PUSH_         ( op ) ." PUSH  " .SEG ;
  163.  
  164. : P/P           ( op ) DUP 1 AND EXEC: PUSH_ POP_ ;
  165.  
  166. SELF.L DAA_ ," DAA"     SELF.L DAS_ ," DAS"
  167. SELF.L AAA_ ," AAA"     SELF.L AAS_ ," AAS"
  168.  
  169. : .ADJ          ( op ) 3 2/S 3 AND EXEC: DAA_ DAS_ AAA_ AAS_ ;
  170.  
  171. : P/SEG         ( op | push  seg override )
  172.                 DUP 5 2/S 1 AND EXEC: P/P SEG: ;
  173.  
  174. : P/ADJ         ( op | pop  adjust )
  175.                 DUP 5 2/S 1 AND EXEC: P/P .ADJ ;
  176.  
  177. SELF.L ADD_ ," ADD"     SELF.L ADC_ ," ADC"
  178. SELF.L AND_ ," AND"     SELF.L XOR_ ," XOR"
  179. SELF.L OR_  ," OR"      SELF.L SBB_ ," SBB"
  180. SELF.L SUB_ ," SUB"     SELF.L CMP_ ," CMP"
  181.  
  182. : .AL/X         ( op ) 1 AND EXEC: AL_ AX_ ;
  183.  
  184. : .ALU          ( op )
  185.                 3 2/S 7 AND EXEC:
  186.                 ADD_ OR_ ADC_ SBB_ AND_ SUB_ XOR_ CMP_ ;
  187.  
  188. : ALU           ( op - op )
  189.                 DUP .ALU DUP 4 AND
  190.                 IF      DUP .AL/X ., .IMM  EXIT
  191.                 THEN    NEXTB OVER 2 AND
  192.                 IF      .REG ., .MREG
  193.                 ELSE    .MREG ?., .REG
  194.                 THEN    2DROP ;
  195.  
  196. : 00-3F         ( op - op | 00-3F )
  197.                 DUP 7 AND EXEC: ALU ALU ALU ALU ALU ALU P/SEG P/ADJ ;
  198.  
  199. :: .REGGP       ( op | register group )
  200.                 CREATE DOES> ID.L .16REG ;
  201.  
  202. .REGGP INC_    ," INC"          .REGGP DEC_   ," DEC"
  203. .REGGP PUSH2_  ," PUSH"         .REGGP POP2_  ," POP"
  204.  
  205. : REGS          ( op | 40-5F )
  206.                 DUP 3 2/S 3 AND EXEC: INC_ DEC_ PUSH2_ POP2_ ;
  207.  
  208. : 60-6F ( op ) .NA ;
  209.  
  210. SELF.L JA_  ," JA"       SELF.L JAE_ ," JAE"
  211. SELF.L JB_  ," JB"       SELF.L JBE_ ," JBE"
  212. SELF.L JE_  ," JE"       SELF.L JG_  ," JG"
  213. SELF.L JGE_ ," JGE"      SELF.L JL_  ," JL"
  214. SELF.L JLE_ ," JLE"      SELF.L JNE_ ," JNE"
  215. SELF.L JNO_ ," JNO"      SELF.L JNS_ ," JNS"
  216. SELF.L JO_  ," JO"       SELF.L JPE_ ," JPE"
  217. SELF.L JPO_ ," JPO"      SELF.L JS_  ," JS"
  218.  
  219. : .BR|          ( op )
  220.                 15 AND
  221.                 EXEC: JO_ JNO_ JB_  JAE_ JE_ JNE_ JBE_ JA_
  222.                       JS_ JNS_ JPE_ JPO_ JL_ JGE_ JLE_ JG_ ;
  223.  
  224. : .BRANCH       ( op | 70-7F branch & dest )
  225.                 .BR| NEXTB SEXT CP @ + .SYMBOL ;
  226.  
  227. : 40-7F         ( op | 40-7F )
  228.                 DUP 4 2/S 3 AND EXEC: REGS REGS 60-6F .BRANCH ;
  229.  
  230. : ALU#          ( op | 80-81 )
  231.                 NEXTB DUP .ALU .MREG ?., ?DISP DROP DUP .IMM .SIZE ;
  232.  
  233. : .NA1X         ( op ext ) .NA1 2R> 2DROP ;
  234.  
  235. : .MATH         ( ext )
  236.                 3 2/S 7 AND
  237.                 EXEC:   ADD_   .NA1X  ADC_   SBB_
  238.                         .NA1X  SUB_   .NA1X  CMP_ ;
  239.  
  240. : 83S           ( op | 83 )
  241.                 NEXTB DUP .MATH .MREG ?., ?DISP BIMM DROP .SIZE ;
  242.  
  243. :: 1GP          ( op | r/m reg )
  244.                 CREATE DOES> ID.L NEXTB .MREG ?., .REG 2DROP ;
  245.  
  246.    1GP TEST1_ ," TEST"       1GP XCHG1_ ," XCHG"
  247. SELF.L LEA_   ," LEA"     SELF.L MOV_   ," MOV"
  248.  
  249. : MOVRM/REG     ( op | 88-89 )
  250.                 MOV_ NEXTB .MREG ?., .REG 2DROP ;
  251.  
  252. : MOVD_         ( op | 8A-8B )
  253.                 MOV_ NEXTB .REG ., .MREG 2DROP ;
  254.  
  255. : MOVS>M        ( op | 8C-8F )
  256.                 NEXTB OVER $8D =
  257.                 IF      LEA_ .REG ., .MREG 2DROP EXIT
  258.                 THEN    OVER $8F =
  259.                 IF      DUP $38 AND IF .NA1 EXIT THEN
  260.                         ." POP   " .MREG
  261.                 ELSE    ( 8C 8E ) DUP $20 AND IF .NA1 EXIT THEN
  262.                         MOV_ SWAP 1 OR ( Force 16bit moves only )
  263.                         SWAP OVER 2 AND
  264.                         IF      ( 8E ) DUP .SEG ., .MREG
  265.                         ELSE    ( 8C ) .MREG ?., DUP .SEG
  266.                         THEN
  267.                 THEN    2DROP ;
  268.  
  269. : 8MOVS         ( op | 80-8F )
  270.                 DUP 2/ 7 AND
  271.                 EXEC: ALU#       83S    TEST1_  XCHG1_
  272.                       MOVRM/REG  MOVD_  MOVS>M  MOVS>M ;
  273.  
  274. SELF.L XCHG2_ ," XCHG"   SELF.L CBW_   ," CBW"
  275. SELF.L CWD_   ," CWD"    SELF.L CALL_  ," CALL"
  276. SELF.L WAIT_  ," WAIT"   SELF.L PUSHF_ ," PUSHF"
  277. SELF.L POPF_  ," POPF"   SELF.L SAHF_  ," SAHF"
  278. SELF.L LAHF_  ," LAHF"   SELF.L TEST2_ ," TEST"
  279.  
  280. : INTER         \ interseg jmp or call
  281.                 .FAR NEXTW NEXTW H. .SYMBOL ;
  282.  
  283. : CALLINTER     ( interseg call ) CALL_ INTER ;
  284.  
  285. : XCHG3_        ( op | 90-97 )
  286.                 DUP 7 AND IF XCHG2_ .16REG ., AX_ EXIT THEN DROP ." NOP " ;
  287.  
  288. : 98-9F         ( op | 98-9F )
  289.                 7 AND
  290.                 EXEC: CBW_ CWD_ CALLINTER WAIT_ PUSHF_ POPF_ SAHF_ LAHF_ ;
  291.  
  292. : 90S           ( op | 90-9F )
  293.                 DUP 3 2/S 1 AND EXEC: XCHG3_ 98-9F ;
  294.  
  295. : MOVA_         ( op | A0-A3 )
  296.                 MOV_ DUP 2 AND
  297.                 IF  WDISP space .AL/X EXIT
  298.                 THEN .AL/X .,  WDISP space ;
  299.  
  300. : MOVS_         ( op | A4-A5 ) ." MOVS  " .SIZE ;
  301. : CMPS_         ( op | A6-A7 ) ." CMPS  " .SIZE ;
  302.  
  303. : TEST3_        ( op | A8-A9 ) TEST2_ DUP .AL/X ., .IMM ;
  304.  
  305. : STOS_         ( op | AA-AB ) ." STOS  " .SIZE ;
  306. : LODS_         ( op | AC-AD ) ." LODS  " .SIZE ;
  307. : SCAS_         ( op | AE-AF ) ." SCAS  " .SIZE ;
  308.  
  309. : A0S           ( op | A0-AF )
  310.                 DUP 2/ 7 AND
  311.                 EXEC: MOVA_ MOVA_ MOVS_ CMPS_ TEST3_ STOS_ LODS_ SCAS_ ;
  312.  
  313. : MOV#          ( op | B0-BF )
  314.                 MOV_ DUP 8 AND
  315.                 IF .16REG ., WIMM EXIT THEN .8REG ., BIMM ;
  316.  
  317. : 80-BF         ( op | 80-BF )
  318.                 DUP 4 2/S 3 AND EXEC: 8MOVS 90S A0S MOV# ;
  319.  
  320. SELF.L LES_  ," LES"     SELF.L LDS_  ," LDS"
  321. SELF.L INTO_ ," INTO"    SELF.L IRET_ ," IRET"
  322.  
  323. : RET_          ( op | C2-C3 CA-CB )
  324.                 ." RET   " DUP 8 AND IF .FAR THEN
  325.                 1 AND 0= IF WDISP ( ??? ) ."  +SP" THEN ;
  326.  
  327. : .L/L          ( op ) 1 AND EXEC: LES_ LDS_ ;
  328.  
  329. : LES/LDS       ( op | C4-C5 )
  330.                 DUP .L/L NEXTB .REG ., .MREG 2DROP ;
  331.  
  332. : MOV#R/M       ( op | C6-C7 )
  333.                 NEXTB DUP $38 AND IF .NA1 EXIT THEN
  334.                 MOV_ .MREG ?., ?DISP DROP DUP .IMM .SIZE ;
  335.  
  336. : INT_          ( op | CC-CD )
  337.                 ." INT   " 1 AND IF NEXTB ELSE 3 THEN H. ;
  338.  
  339. : INTO/IRET     ( op | CE-CF )
  340.                 1 AND EXEC: INTO_ IRET_ ;
  341.  
  342. : C0S           ( op | C0-CF )
  343.                 DUP 2/ 7 AND
  344.                 EXEC: .NA RET_ LES/LDS MOV#R/M .NA RET_ INT_ INTO/IRET ;
  345.  
  346. SELF.L ROL_ ," ROL"      SELF.L ROR_ ," ROR"
  347. SELF.L RCL_ ," RCL"      SELF.L RCR_ ," RCR"
  348. SELF.L SHL_ ," SHL"      SELF.L SHR_ ," SHR"
  349. SELF.L SAR_ ," SAR"
  350.  
  351. : .SHIFTS       ( ext )
  352.                 3 2/S 7 AND EXEC:
  353.                 ROL_ ROR_ RCL_ RCR_ SHL_ SHR_ .NA0 SAR_ ;
  354.  
  355. : SHIFTS        ( op | D0-D3 )
  356.                 NEXTB DUP 3 2/S 7 AND 6 = IF .NA1 EXIT THEN
  357.                 DUP .SHIFTS .MREG DROP 2 AND IF ?., CL_ THEN ;
  358.  
  359. : AAM_          ( op | D4 )  ." AAM   " NEXTB 2DROP ;
  360. : AAD_          ( op | D5 )  ." AAD   " NEXTB 2DROP ;
  361. : XLAT_         ( op | D7 )  ." XLAT  " DROP ;
  362.  
  363. : ESC_          ( op ext - op ext | D8-DF )
  364.                 ." ESC   " 2DUP $38 AND SWAP 7 AND OR . .MREG ;
  365.  
  366. : D0S           ( op | D0-DF )
  367.                 DUP 8 AND
  368.                 IF      NEXTB ESC_ 2DROP EXIT
  369.                 THEN
  370.                 DUP 7 AND
  371.                 EXEC:   SHIFTS  SHIFTS  SHIFTS  SHIFTS
  372.                         AAM_    AAD_    .NA     XLAT_  ;
  373.  
  374. SELF.L LOOPE_  ," LOOPE"
  375. SELF.L LOOP1_  ," LOOP"
  376. SELF.L LOOPNE_ ," LOOPNE"
  377. SELF.L JCXZ_   ," JCXZ"
  378.  
  379. : .LOOP         ( op )
  380.                 3 AND EXEC:
  381.                 LOOPNE_  LOOPE_  LOOP1_  JCXZ_  ;
  382.  
  383. : LOOPS_         ( op | E0-E3 )
  384.                 .LOOP NEXTB SEXT CP @ + .SYMBOL ;
  385.  
  386. SELF.L IN_  ," IN"
  387. SELF.L OUT_ ," OUT"
  388. SELF.L JMP_ ," JMP"
  389.  
  390. : IO#           ( op | E4-E7 )
  391.                 DUP 2 AND
  392.                 IF      OUT_  BIMM   .AL/X
  393.                 ELSE    IN_   .AL/X  .,     BIMM
  394.                 THEN    ;
  395.  
  396. : IOX           ( op | EC-EF )
  397.                 DUP 2 AND
  398.                 IF      OUT_  DX_    .,  .AL/X
  399.                 ELSE    IN_   .AL/X  .,  DX_
  400.                 THEN    ;
  401.  
  402. : .CALL         ( op )
  403.                 3 AND EXEC: CALL_ JMP_ JMP_ JMP_ ;
  404.  
  405. : CALLS_        ( op | E8-EB )
  406.                 DUP .CALL DUP 2 AND
  407.                 IF      DUP 1 AND
  408.                         IF NEXTB SEXT CP @ + .SYMBOL
  409.                         ELSE INTER
  410.                         THEN
  411.                 ELSE    NEXTW CP @ + .SYMBOL
  412.                         ( make smart about DEBUG's tricks and E0 )
  413.                         DUP $0E9 = CP @ C@ $0E0 = AND IF 1 CP +! THEN
  414.                 THEN    DROP ;
  415.  
  416. : E0S           ( op | E0-EF )
  417.                 DUP 2 2/S 3 AND EXEC: LOOPS_ IO# CALLS_ IOX ;
  418.  
  419. : FTEST         ( op | F6-F7 )
  420.                 TEST2_ .MREG ?., ?DISP DROP DUP .IMM .SIZE ;
  421.  
  422. SELF.L NOT1_ ," NOT"     SELF.L NEG_   ," NEG"
  423. SELF.L MUL_  ," MUL"     SELF.L IMUL_  ," IMUL"
  424. SELF.L DIV_  ," DIV"     SELF.L IDIV_  ," IDIV"
  425. SELF.L REP_  ," REP"     SELF.L REPNE_ ," REPNE"
  426. SELF.L LOCK_ ," LOCK"    SELF.L HLT_   ," HLT"
  427. SELF.L CMC_  ," CMC"     SELF.L CLC_   ," CLC"
  428. SELF.L STC_  ," STC"     SELF.L CLI_   ," CLI"
  429. SELF.L STI_  ," STI"     SELF.L CLD_   ," CLD"
  430. SELF.L STD_  ," STD"     SELF.L INC1_  ," INC"
  431. SELF.L DEC1_ ," DEC"     SELF.L PUSH3_ ," PUSH"
  432.  
  433. : .MUL/DIV      ( ext )
  434.                 3 2/S 3 AND EXEC: MUL_ IMUL_ DIV_ IDIV_ ;
  435.  
  436. : MUL/DIV ( op ext | F6-F7 )
  437.   DUP .MUL/DIV .MREG 2DROP ;
  438.  
  439. : .NOT/NEG      ( ext )
  440.                 3 2/S 1 AND EXEC: NOT1_ NEG_ ;
  441.  
  442. : NOT/NEG       ( op ext | F6-F7 )
  443.                 DUP .NOT/NEG .MREG 2DROP ;
  444.  
  445. : F6-F7S        ( op | F6-F7 )
  446.                 NEXTB DUP 3 2/S 7 AND
  447.                 EXEC:   FTEST    .NA1     NOT/NEG  NOT/NEG
  448.                         MUL/DIV  MUL/DIV  MUL/DIV  MUL/DIV ;
  449.  
  450. : .FES          ( ext )
  451.                 3 2/S 1 AND EXEC: INC1_ DEC1_ ;
  452.  
  453. : FES_          ( op | FE )
  454.                 NEXTB DUP 3 2/S 6 AND
  455.                 IF      .NA1
  456.                 ELSE    DUP .FES .MREG 2DROP
  457.                 THEN    ;
  458.  
  459. : .FCALL/JMP    ( ext )
  460.                 2/ 1 AND EXEC: JMP_ CALL_ ;
  461.  
  462. : FCALL/JMP     ( op ext | FF )
  463.                 DUP 3 2/S DUP .FCALL/JMP 1 AND
  464.                 IF .FAR THEN .MREG 2DROP ;
  465.  
  466. : FPUSH_        ( op ext | FF )
  467.                 DUP 4 AND
  468.                 IF      PUSH3_ .MREG 2DROP
  469.                 ELSE    .NA1
  470.                 THEN    ;
  471.  
  472. : .FINC         ( op ext )
  473.                 3 2/S 1 AND EXEC: INC1_ DEC1_ ;
  474.  
  475. : FINC_         ( op ext | FF )
  476.                 DUP .FINC .MREG $0C7 AND 6 = IF WORD_ THEN DROP ;
  477.  
  478. : FFS_          ( op | FF )
  479.                 NEXTB DUP 4 2/S 3 AND
  480.                 EXEC: FINC_ FCALL/JMP FCALL/JMP FPUSH_ ;
  481.  
  482. : .NAF1         ( a - a ) DISSEG @ OVER C@L .NA ;
  483.  
  484. : F0S           ( op | F0-FF )
  485.                 DUP 15 AND DUP 7 AND 6 < IF NIP THEN
  486.                 EXEC:   LOCK_  .NAF1 REPNE_  REP_
  487.                         HLT_   CMC_  F6-F7S  F6-F7S
  488.                         CLC_   STC_  CLI_    STI_
  489.                         CLD_   STD_  FES_    FFS_ ;
  490.  
  491. : C0-FF         ( op | C0-FF )
  492.                 DUP 4 2/S 3 AND EXEC: C0S D0S E0S F0S ;
  493.  
  494. : .INST         ( op )
  495.                 255 AND DUP 6 2/S
  496.                 EXEC: 00-3F 40-7F 80-BF C0-FF ;
  497.  
  498. : INST          \ display opcode at ip  advancing as needed
  499.                 save> base hex
  500.                 CP @ 0 <# # # # # #> TYPE 4 SPACES
  501.                 CP @ >R
  502.                 #OUT @ >R
  503.                 NEXTB .INST
  504.                 OPS @ CP +!
  505.                 R> #OUT @ - 28 + 1 max SPACES
  506.                 R> CP @ SWAP
  507.                 ?DO     I TC@ 0 <# # # #> TYPE
  508.                 LOOP
  509.                 OPS OFF
  510.                 DISP OFF
  511.                 restore> base ;
  512.  
  513.   15000 constant symmax
  514.       0 value    symbuf
  515.       0 value    symcnt
  516.       0 value    symptr
  517.         handle   symhndl
  518.       0 value    comseg
  519.       0 value    comcnt
  520.  
  521. : read_sym      ( -- )          \ read the symbol file from disk
  522.                 bl word symhndl $>handle
  523.                 " SYM" ">$ symhndl $>ext
  524.                 symhndl hopen
  525.                 if      cr ." Could not open " symhndl count type
  526.                         ." , no symbols available."
  527.                         off> symcnt symbuf off exit
  528.                 then    cr ." Opened " symhndl count type ." , read "
  529.                 symbuf symmax symhndl hread dup =: symcnt
  530.                 U. ." bytes"
  531.                 symhndl hclose drop ;
  532.  
  533. : mash1sym      ( a1 n1 -- )    \ mash one symbol into place
  534.                 1-                                      \ reduce len by 1
  535.                 2dup $20 scan $20 skip 2dup 2>r nip -   \ parse address
  536.                 here place                              \ place at here
  537.                 here number? 2drop symptr !             \ convert to number
  538.                 2 +!> symptr                            \ bump over saved #
  539.                 2r> dup>r symptr place                  \ append name
  540.                 symptr c@ $7F and symptr c!             \ clip to 7 bits
  541.                 r> 1+ +!> symptr ;                      \ bump over name
  542.  
  543. : mash_sym      ( -- )          \ mash the symbol table into a usable form
  544.                 save> base hex
  545.                 symbuf !> symptr                \ initialize symbol pointer
  546.                 symbuf symcnt
  547.                 begin   2dup $0A scan 2dup 2>r nip - dup 5 >
  548.                         if      mash1sym
  549.                         else    2drop           \ too short to be a symbol
  550.                         then
  551.                         2r>  dup
  552.                 while   1 /string
  553.                 repeat  2drop
  554.                 symptr symbuf - !> symcnt
  555.                 restore> base ;
  556.  
  557. : .disusage     ( -- )
  558.                 cr ." Could not open " symhndl count type
  559.                 cr cr
  560.                 ." Usage: DIS <filename> <starting_symbol> <enter>"
  561.                 cr ." leaving" abort ;
  562.  
  563. : read_com      ( -- )          \ assumes symbol file has been read
  564.                 " COM" ">$ symhndl $>ext
  565.                 symhndl hopen if .disusage then
  566.                 $1000 alloc 8 =                 \ allocate some space for
  567.                                                 \ the .COM file.
  568.                 if      cr ." Not enough memory, leaving" abort
  569.                 then    =: comseg drop
  570.                 cr ." Opened " symhndl count type ." , read "
  571.                 $100 $FE00 symhndl comseg exhread dup =: comcnt
  572.                 u. ." bytes"
  573.                 symhndl hclose drop ;
  574.  
  575. comment:
  576. : %?symbol      ( a1 -- <a2 n1> f1 )    \ given a1 the symbol address, return
  577.                                         \ a2 n1 f1 = true if symbol found
  578.                                         \ else f1 false symbol not found
  579.                 0 <# # # # # #> drop =: symptr
  580.                 symbuf symcnt
  581.                 begin   over symptr 4 comp over 0> and
  582.                 while   $0A scan 1 /string
  583.                 repeat  dup
  584.                 if      2dup $0A scan nip -     \ parse line
  585.                         bl scan bl skip         \ remove leading number
  586.                         1- 0max
  587.                         over dup c@ $7F and swap c!
  588.                         true                    \ remove trailing CR
  589.                 else    2drop false
  590.                 then    ;
  591. comment;
  592.  
  593. : %?symbol      ( a1 -- <a2 n1> f1 )    \ given a1 the symbol address, return
  594.                                         \ a2 n1 f1 = true if symbol found
  595.                                         \ else f1 false symbol not found
  596.                 !> symptr
  597.                 symbuf symcnt
  598.                 begin   over @ symptr <> over 0> and
  599.                 while   over 2+ c@ 3 + /string
  600.                 repeat  dup
  601.                 if      drop 2+ count
  602. \                        over dup c@ $7F and swap c!
  603.                         true                    \ remove trailing CR
  604.                 else    2drop false
  605.                 then    ;
  606.  
  607. defer ?symbol
  608.  
  609. : ?.symbol      ( a1 -- )
  610.                 dup ?symbol
  611.                 if      type
  612.                 else    dup H.
  613.                 then    drop ;
  614.  
  615. : show_symbol   ( -- <a2 n1> f1 )
  616.                 cp @ ?symbol ;
  617.  
  618. : ?address      ( a1 -- <a2> f1 )       \ given a1 the symbol name, return
  619.                                         \ a2 addr, & f1 = true if addr found
  620.                                         \ else f1 false addr not found
  621.                 ?uppercase =: symptr
  622.                 symptr c@ dup 0= ?exit drop
  623.                 symptr number? nip      \ pass in a number directly
  624.                 if      true exit
  625.                 then    drop
  626.                 $0D symptr count + c!
  627.                 symbuf symcnt
  628.                 begin   over 5 + symptr count 1+ caps-comp over 0> and
  629.                 while   $0A scan 1 /string
  630.                 repeat  dup
  631.                 if      2dup bl scan nip -     \ parse line
  632.                         here place
  633.                         bl here count + c!
  634.                         here number? nip
  635.                 else    2drop false
  636.                 then    ;
  637.  
  638. 0 value linseg
  639. 0 value lincnt
  640. 0 value linstart
  641. 0 value srcline
  642. 0 value targaddr
  643. 0 value ?src
  644. 80 array sline_buf
  645.  
  646.  
  647. : read_lin      ( -- )
  648.                 " LIN" ">$ symhndl $>ext
  649.                 symhndl hopen
  650.                 if      cr ." Could not open " symhndl count type
  651.                         exit
  652.                 then
  653.                 $1000 alloc 8 =                 \ allocate some space for
  654.                                                 \ the .COM file.
  655.                 if      cr ." Not enough memory, leaving" abort
  656.                 then    =: linseg drop
  657.                 cr ." Opened " symhndl count type ." , read "
  658.                 $00 $FF00 symhndl linseg exhread dup =: lincnt
  659.                 u. ." bytes"
  660.                 symhndl hclose drop ;
  661.  
  662. : getsline      ( -- f1 )
  663.                 linseg save!> sseg
  664.                 linstart lincnt 2dup $0A scan
  665.                 2dup 1 /string =: lincnt =: linstart
  666.                 nip - 79 min >r linseg swap ?ds: sline_buf 1+ r@ cmovel
  667.                 r> sline_buf c!
  668.                 restore> sseg
  669.                 sline_buf c@ 0= ?dup ?exit      \ stop if at end of lines
  670.                 sline_buf count 2dup bl scan 2dup 2>r nip - here place
  671.                 bl here count + c!
  672.                 here number? 2drop =: targaddr
  673.                 2r> bl skip 2dup $0D scan nip - dup
  674.                 if      here place
  675.                         bl here count + c!
  676.                         lreadhndl hclose drop
  677.                         here lreadhndl $>handle
  678.                         lreadhndl hopen         ( -- f1 )
  679.                         ibreset
  680.                 else    2drop false
  681.                 then    ;
  682.  
  683. 0 value slmargin                \ source left margin
  684. 0 value #pages
  685. 0 value maxpages
  686.  
  687. : wide_check?   ( -- )          \ display in 132 columns
  688.                 1000 !> maxpages
  689.                 >in @
  690.                 bl word 1+ " /W" compare
  691.                 if      >in !
  692.                         off> slmargin
  693. \                       27 emit " &l7.27C       type
  694. \                       27 emit " &k0S"         type \ laserjet uncompressed
  695.                         exit
  696.                 then    drop cr
  697.                 >in @ here c@ 2- - >in !   \ backup to after "/W"
  698.                 bl word number?
  699.                 if      drop !> maxpages        \ set max pages
  700.                 else    2drop
  701.                 then
  702.                 51 !> slmargin
  703.                 27 emit " &l7.27C"      type
  704.                 27 emit " &k2S"         type \ laserjet compressed
  705.                 5 #line ! ;
  706.  
  707. : ?.new_page    ( -- )
  708.                 slmargin 0= ?exit
  709.                 #line @ 62 < ?exit
  710.                 cr cr
  711.                 ."    Page# " #pages 1+ 3 .r
  712.                 ."    Tcom Disassembler by Tom Zimmer"
  713.                 cr 12 emit #line off
  714.                 incr> #pages
  715.                 #pages maxpages >=
  716.                 if      0 0 bdos        \ leave program
  717.                 then    cr cr ;
  718.  
  719. : .source_line  ( -- )
  720.                 save> base decimal
  721.                 slmargin spaces
  722.                 loadline @ 5 .r space
  723.                 lineread count 2- 0max type cr
  724.                 restore> base ;
  725.  
  726. : show_source   ( -- )
  727.                 ?src 0= ?exit
  728.                 begin   cp @ targaddr u>=
  729.                 while   .source_line
  730.                         ?.new_page
  731.                         getsline
  732.                         if      -1 =: targaddr
  733.                                 off> ?src
  734.                         then
  735.                         ?keypause
  736.                 repeat  ;
  737.  
  738. : skip_source   ( -- )
  739.                 ?src 0= ?exit
  740.                 begin   cp @ $10 - targaddr u>=
  741.                 while   lineread drop
  742.                         getsline
  743.                         if      -1 =: targaddr
  744.                                 off> ?src
  745.                         then
  746.                         ?keypause
  747.                 repeat  ;
  748.  
  749. : DIS           ( a1 -- )       \ disassemble from address a1
  750.                 cp ! ?cs: =seg
  751.                 begin   cr
  752.                         show_symbol
  753.                         if ." ; " type cr then
  754.                         8 spaces
  755.                         INST
  756.                         ?KEYPAUSE
  757.                 again   cr ;
  758.  
  759. [FORTH] ?DIS 0= [TARGET]        \ If we are not just appending disassembler
  760. #IF                             \ but are actually building a standalone
  761.                                 \ disassembler, then include this
  762.  
  763. : .1inst_line   ( -- )
  764.                 CR
  765.                 show_source
  766.                 show_symbol
  767.                 if ." ; " type cr then
  768.                 8 spaces
  769.                 INST ;
  770.  
  771. VARIABLE CPEND
  772.  
  773. : DISASSEM      ( -- )
  774.                 CAPS ON
  775.                 ?ds: sseg !
  776.                 DOSIO_INIT                      \ init EMIT, TYPE & SPACES
  777.                 symmax 2+ ds:alloc =: symbuf
  778.                 $FFF0 SET_MEMORY                \ default to 64k code space
  779.                 DOS_TO_TIB                      \ move command tail to TIB
  780.                 DECIMAL
  781.                 lineread_init
  782.                 ['] ?.symbol is .symbol
  783.                 ['] %?symbol is ?symbol
  784.                 off> #pages
  785.                 read_sym                        \ read symbol table
  786.                 mash_sym
  787.                 read_com                        \ read .COM file
  788.                 read_lin
  789.                 getsline dup 0= =: ?src
  790.                 if      cr ." Could not open source file"
  791.                 then
  792.                 comseg =SEG
  793.                 HEX
  794.                 cr
  795.                 wide_check?
  796.                 bl word ?address        \ find word following, if found
  797.                 if      cp !            \ set as starting address
  798.                         skip_source     \ walk past previous source lines
  799.                 else    $100 cp !       \ else use $100 for starting
  800.                 then    symcnt                  \ if symbol file presend,
  801.                 if      comseg $0103 @L $10 *   \ then assume its a TCOM file
  802.                 else    $FF00                   \ else just do whole .COM file
  803.                 then    comcnt cp @ + umin cpend !
  804.                 BEGIN   .1inst_line
  805.                         ?.new_page
  806.                         ?KEYPAUSE
  807.                         CP @ CPEND @ U>
  808.                 UNTIL   cr slmargin
  809.                 if      12 emit
  810.                 then    ;
  811.  
  812. #ENDIF
  813.  
  814.