home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / dis8086.seq < prev    next >
Encoding:
Text File  |  1989-04-19  |  14.5 KB  |  588 lines
  1. \ DIS8086.SEQ   8086 Disassembler  by Charles Curley
  2.  
  3.   PREFIX  \ Conversion by  Bill Muench  9 September 88  Fixes
  4. \ More 'Not Used' Trapped
  5. \ XCHGA for NOP  FES for 8reg INC DEC
  6. \ REP REPNE  MUL/DIV  POP CS  ESC
  7.  
  8. FORTH DEFINITIONS  DECIMAL
  9. ANEW PRE  WARNING OFF
  10.  
  11. VOCABULARY DIS8086
  12.  
  13. comment:  To DisAssemble to a file:
  14.   PFILE <file_spec>
  15.   PRINT SEE <name>
  16.   PCLOSE
  17.  
  18. : PCLOSE ( - \ Restore printing to printer )
  19.   PRNHNDL HCLOSE DROP
  20.   " PRN." ">$ PRNHNDL $>HANDLE  PRNHNDL HOPEN DROP
  21.   ['] <?PTR.READY> IS ?PRINTER.READY ;
  22.  
  23. : PFILE ( - \ <file.spec> \ Print to diskfile )
  24.   PRNHNDL HCLOSE DROP
  25.    BL WORD PRNHNDL $>HANDLE  PRNHNDL HCREATE
  26.   IF PCLOSE TRUE ABORT" FAILED TO CREATE FILE."
  27.   ELSE ['] TRUE IS ?PRINTER.READY
  28.   THEN ;
  29.  
  30. comment;
  31.  
  32. : COL ( n ) #OUT @ - SPACES ;
  33.  
  34. : .ID| ( nf \ no trailing space )
  35.    DUP 1+  DUP YC@ ROT YC@ 31 AND 0
  36.   ?DO DUP 127 AND FEMIT 128 AND
  37.    IF ASCII _ 128 OR ELSE 1+ DUP YC@ THEN
  38.   LOOP 2DROP ;
  39.  
  40. \ VARIABLE DUMPSEG
  41. : =SEG ( seg ) DUMPSEG ! ;
  42. : .SEG ( - ) DUMPSEG @ U. ;
  43.  
  44. CODE 2/S ( n ct - n'| shift n right ct )
  45.   POP CX
  46.   POP AX
  47.   SHR AX, CL
  48.   1PUSH
  49. END-CODE
  50.  
  51. CODE 2*S ( n ct - n' | shift n left ct )
  52.   POP CX
  53.   POP AX
  54.   SHL AX, CL
  55.   1PUSH
  56. END-CODE
  57.  
  58. CODE SEXT ( n - n' | sign extend byte to word )
  59.   POP AX
  60.   CBW
  61.   1PUSH
  62. END-CODE
  63.  
  64. VARIABLE SYMBOLIC \ Show registers as FORTH registers
  65.   SYMBOLIC ON
  66.  
  67. VARIABLE ID0      \ DisAssembly NAME delay in ms
  68.   700 ID0 !
  69.  
  70. VARIABLE RELOC    \ Relocation factor for dump or dis ???
  71.   RELOC OFF
  72.  
  73. DIS8086 DEFINITIONS
  74.  
  75. \ Avoid name conflicts
  76. : LOOPP [COMPILE] LOOP ; IMMEDIATE
  77. : ANDD AND ;
  78. : ORR  OR ;
  79. : XORR XOR ;
  80. : NOTT NOT ;
  81.  
  82. : WITHIN ( n l h - ? \ Circular. /* NOT F83 */ )
  83.   OVER - >R - R> U< ;
  84. \ : NUF? ( - ? ) KEY? DUP IF KEY 2DROP KEY 27 = THEN ;
  85.  
  86. : +RELOC ( a ) RELOC @ + DUMPSEG @ SWAP ;
  87. : (T@) ( a - w ) +RELOC @L ;
  88. : (TC@) ( a - n ) +RELOC C@L ;
  89.  
  90. DEFER T@ ( a - w )
  91. DEFER TC@ ( a - n )
  92. : MEMORY  ['] (TC@) IS TC@  ['] (T@)  IS T@ ; MEMORY
  93.  
  94. \ : DUMPBOOT MEMORY ?CS: =SEG [ ' BOOT >BODY @ , ] ;
  95. \ ' DUMPBOOT IS BOOT
  96.  
  97. : .IND ( indirect \ Someday!! ) ; \ POSTVAR @ IF ." #) " THEN ;
  98.  
  99. : .# ." # " ;
  100. : ., ." , " ;
  101. : ?., ( op - op ) DUP $0C7 ANDD 6 <> IF ., THEN ;
  102. : .FAR ." FAR " ;
  103. : ID.L ( a ) #OUT @ SWAP .ID| #OUT @ - 8 + SPACES ;
  104. : SELF.L ( Left Justified Self-doc! )
  105.   CREATE LAST @ , DOES> @ ID.L ;
  106. : .SELF ( Self-doc! ) CREATE LAST @ , DOES> @ .ID| ;
  107. : .ME \ print current name
  108.   LAST @ [COMPILE] LITERAL COMPILE ID.L ; IMMEDIATE
  109.  
  110. VARIABLE CP
  111. : NEXTB ( - n ) CP @ TC@ 1 CP +! ;
  112. : NEXTW ( - w ) CP @ T@  2 CP +! ;
  113.  
  114. : .NA ( n ) ."   ??? " U. ;
  115. : .NA0 ( n - n ) DUP .NA ;
  116. : .NA1 ( op ext ) SWAP .NA U. ;
  117.  
  118. VARIABLE OPS  \ operand count
  119. VARIABLE DISP \ 2nd operand ext, flag, ct
  120.  
  121. : ?DISP ( op ext - op ext | ?MOD disp )
  122.    DUP 6 2/S ?DUP 0=
  123.   IF ( MOD=0 ) DUP 7 ANDD ( ?R/M ) 6 = 2 ANDD
  124.   THEN DUP 3 = IF ( MOD=3 ) DROP 0 THEN DISP ! ;
  125.  
  126. .SELF AL  .SELF AX   .SELF [BX+SI]  .SELF ES
  127. .SELF CL  .SELF CX   .SELF [BX+DI]  .SELF CS
  128. .SELF DL  .SELF DX   .SELF [BP+SI]  .SELF SS
  129. .SELF BL  .SELF BX   .SELF [BP+DI]  .SELF DS
  130. .SELF AH  .SELF SP   .SELF [SI]
  131. .SELF CH  .SELF BP   .SELF [DI]
  132. .SELF DH  .SELF SI   .SELF [BP]
  133. .SELF BH  .SELF DI   .SELF [BX]
  134. .SELF RP  .SELF [RP] \ Return Stack Pointer
  135. .SELF IP  .SELF [IP] \ Interpreter Pointer
  136. .SELF W   .SELF [W]  \ Working Register
  137.  
  138. SELF.L NEXT   SELF.L 1PUSH  SELF.L 2PUSH
  139. SELF.L BRAN1  SELF.L PLOOP
  140.  
  141. CREATE SYMBOLS
  142. ASSEMBLER
  143.   >NEXT , >NEXT 1- , >NEXT 2- , ' BRANCH >BODY , ' (LOOP) 5 + ,
  144. DIS8086
  145.   HERE SYMBOLS - 2/ CONSTANT SYMBOLCT
  146.  
  147. : ?SYMBOL ( a - a ? | if n = -1 no symbol else index )
  148.    TRUE DUMPSEG @ ?CS: = SYMBOLIC @ 0<> AND
  149.   IF SYMBOLCT 0 ( iff in code segment )
  150.    DO OVER I 2* SYMBOLS + @ = IF DROP I LEAVE THEN
  151.    LOOPP
  152.   THEN ;
  153.  
  154. : .SYMBOL ( a | name or value )
  155.   ?SYMBOL DUP 0< IF DROP U. EXIT THEN
  156.    NIP EXEC: NEXT 1PUSH 2PUSH BRAN1 PLOOP ;
  157.  
  158. : SYMBOL
  159.   CREATE ' >NAME , ' >NAME ,
  160.   DOES> SYMBOLIC @ IF 2+ THEN @ .ID| ;
  161.  
  162. \ SYMBOL BX BX W   SYMBOL [BX] [BX] [W]
  163. SYMBOL SI SI IP  SYMBOL [SI] [SI] [IP]
  164. SYMBOL BP BP RP  SYMBOL [BP] [BP] [RP]
  165.  
  166. .SELF BYTE  .SELF WORD
  167.  
  168. : .SIZE ( op ) 1 ANDD EXEC: BYTE WORD ;
  169.  
  170. : .8REG ( ext )
  171.   7 ANDD EXEC: AL CL DL BL AH CH DH BH ;
  172.  
  173. : .16REG ( ext )
  174.   7 ANDD EXEC: AX CX DX BX SP BP SI DI ;
  175.  
  176. : .R8/16 ( op ext )
  177.   SWAP 1 ANDD EXEC: .8REG .16REG ;
  178.  
  179. : .R/M ( op ext - op ext ) 2DUP .R8/16 ;
  180. : .REG ( op ext - op ext ) 2DUP 3 2/S .R8/16 ;
  181.  
  182. : 0DISP ." 0 " ;
  183.  
  184. : BDISP| \ byte displacement
  185.   CP @ DISP @ + TC@    1 OPS +! ;
  186.  
  187. : BDISP \ byte displacement
  188.   BDISP| SEXT . ;
  189.  
  190. : WDISP \ word displacement
  191.   CP @ DISP @ + T@ U.  2 OPS +! ;
  192.  
  193. : .DISP ( op ext - op ext )
  194.   DUP 6 2/S 3 ANDD EXEC: 0DISP BDISP WDISP .R/M ;
  195.  
  196. : BIMM ( byte immediate ) .# BDISP| . ;
  197. : WIMM ( word immediate ) .# WDISP ;
  198.  
  199. : .IMM ( op ) 1 ANDD IF WIMM EXIT THEN BIMM ;
  200.  
  201. : .MREG ( op ext - op ext | reg + disp )
  202.   $0C0 2DUP ANDD = IF ( MOD=3 ) .R/M EXIT THEN
  203.   DUP $0C7 ANDD 6 =
  204.    IF ( MOD=0 R/M=6 ) .IND WDISP EXIT
  205.    THEN  .DISP  DUP 7 ANDD ( MOD=1 or 2 )
  206.   EXEC: [BX+SI] [BX+DI] [BP+SI] [BP+DI] [SI] [DI] [BP] [BX] ;
  207.  
  208. : .SEG ( op ) 3 2/S 3 ANDD EXEC: ES CS SS DS ;
  209. : SEG: ( op | segment override ) .SEG ." :" ;
  210.  
  211. : POP ( op ) DUP 15 = IF .NA EXIT THEN .ME .SEG ;
  212. : PUSH ( op ) .ME .SEG ;
  213. : P/P ( op ) DUP 1 ANDD EXEC: PUSH POP ;
  214.  
  215. SELF.L DAA  SELF.L DAS  SELF.L AAA  SELF.L AAS
  216.  
  217. : .ADJ ( op ) 3 2/S 3 ANDD EXEC: DAA DAS AAA AAS ;
  218.  
  219. : P/SEG ( op | push  seg override )
  220.   DUP 5 2/S 1 ANDD EXEC: P/P SEG: ;
  221. : P/ADJ ( op | pop  adjust )
  222.   DUP 5 2/S 1 ANDD EXEC: P/P .ADJ ;
  223.  
  224. SELF.L ADD SELF.L ADC  SELF.L AND  SELF.L XOR
  225. SELF.L OR  SELF.L SBB  SELF.L SUB  SELF.L CMP
  226.  
  227. : .AL/X ( op ) 1 ANDD EXEC: AL AX ;
  228.  
  229. : .ALU ( op )
  230.   3 2/S 7 ANDD EXEC: ADD OR ADC SBB AND SUB XOR CMP ;
  231.  
  232. : ALU ( op - op )
  233.    DUP .ALU DUP 4 ANDD
  234.   IF DUP .AL/X ., .IMM  EXIT
  235.   THEN  NEXTB OVER 2 ANDD
  236.   IF .REG ., .MREG
  237.   ELSE .MREG ?., .REG
  238.   THEN 2DROP ;
  239.  
  240. : 00-3F ( op - op | 00-3F )
  241.   DUP 7 ANDD
  242.   EXEC: ALU ALU ALU ALU ALU ALU P/SEG P/ADJ ;
  243.  
  244. : .REGGP ( op | register group )
  245.   CREATE LAST @ , DOES> @ ID.L .16REG ;
  246.  
  247. .REGGP INC  .REGGP DEC  .REGGP PUSH  .REGGP POP
  248.  
  249. : REGS ( op | 40-5F )
  250.   DUP 3 2/S 3 ANDD EXEC: INC DEC PUSH POP ;
  251.  
  252. : 60-6F ( op ) .NA ;
  253.  
  254. SELF.L JA   SELF.L JAE  SELF.L JB   SELF.L JBE
  255. SELF.L JE   SELF.L JG   SELF.L JGE  SELF.L JL
  256. SELF.L JLE  SELF.L JNE  SELF.L JNO  SELF.L JNS
  257. SELF.L JO   SELF.L JPE  SELF.L JPO  SELF.L JS
  258.  
  259. : .BR| ( op )
  260.    15 ANDD
  261.   EXEC: JO JNO JB  JAE JE JNE JBE JA
  262.         JS JNS JPE JPO JL JGE JLE JG ;
  263.  
  264. : .BRANCH ( op | 70-7F branch & dest )
  265.   .BR| NEXTB SEXT CP @ + .SYMBOL ;
  266.  
  267. : 40-7F ( op | 40-7F )
  268.   DUP 4 2/S 3 ANDD EXEC: REGS REGS 60-6F .BRANCH ;
  269.  
  270. : ALU# ( op | 80-81 )
  271.   NEXTB DUP .ALU .MREG ?., ?DISP DROP DUP .IMM .SIZE ;
  272.  
  273. : .NA1X ( op ext ) .NA1 2R> 2DROP ;
  274. : .MATH ( ext )
  275.   3 2/S 7 ANDD EXEC: ADD .NA1X ADC SBB .NA1X SUB .NA1X CMP ;
  276.  
  277. : 83S ( op | 83 )
  278.   NEXTB DUP .MATH .MREG ?., ?DISP BIMM DROP .SIZE ;
  279.  
  280. : 1GP ( op | r/m reg )
  281.   CREATE LAST @ ,
  282.   DOES> @ ID.L NEXTB .MREG ?., .REG 2DROP ;
  283.  
  284. 1GP TEST  1GP XCHG  SELF.L LEA  SELF.L MOV
  285.  
  286. : MOVRM/REG ( op | 88-89 )
  287.   MOV NEXTB .MREG ?., .REG 2DROP ;
  288.  
  289. : MOVD ( op | 8A-8B )
  290.   MOV NEXTB .REG ., .MREG 2DROP ;
  291.  
  292. : MOVS>M ( op | 8C-8F )
  293.    NEXTB OVER $8D =
  294.   IF LEA .REG ., .MREG
  295.   ELSE OVER $8F =
  296.    IF DUP $38 ANDD IF .NA1 EXIT THEN
  297.     [ ' POP >NAME ] LITERAL ID.L .MREG
  298.    ELSE ( 8C 8E ) DUP $20 ANDD IF .NA1 EXIT THEN
  299.      MOV SWAP 1 ORR ( Force 16bit moves only )
  300.      SWAP OVER 2 ANDD
  301.     IF ( 8E ) DUP .SEG ., .MREG
  302.     ELSE ( 8C ) .MREG ?., DUP .SEG
  303.     THEN
  304.    THEN
  305.   THEN 2DROP ;
  306.  
  307. : 8MOVS ( op | 80-8F )
  308.   DUP 2/ 7 ANDD
  309.   EXEC: ALU# 83S TEST XCHG MOVRM/REG MOVD MOVS>M MOVS>M ;
  310.  
  311. SELF.L XCHG  SELF.L CBW    SELF.L CWD   SELF.L CALL
  312. SELF.L WAIT  SELF.L PUSHF  SELF.L POPF  SELF.L SAHF
  313. SELF.L LAHF  SELF.L TEST
  314.  
  315. : INTER \ interseg jmp or call
  316.   .FAR NEXTW NEXTW U. .SYMBOL ;
  317.  
  318. : CALLINTER ( interseg call ) CALL INTER ;
  319.  
  320. : XCHGA ( op | 90-97 )
  321.   DUP 7 ANDD IF XCHG .16REG ., AX EXIT THEN DROP ." NOP " ;
  322.  
  323. : 98-9F ( op | 98-9F )
  324.   7 ANDD
  325.   EXEC: CBW CWD CALLINTER WAIT PUSHF POPF SAHF LAHF ;
  326.  
  327. : 90S ( op | 90-9F )
  328.   DUP 3 2/S 1 ANDD EXEC: XCHGA 98-9F ;
  329.  
  330. : MOVA ( op | A0-A3 )
  331.    MOV DUP 2 ANDD
  332.   IF .IND WDISP .AL/X EXIT
  333.   THEN .AL/X ., .IND WDISP ;
  334.  
  335. : MOVS ( op | A4-A5 ) .ME .SIZE ;
  336. : CMPS ( op | A6-A7 ) .ME .SIZE ;
  337.  
  338. : .TEST ( op | A8-A9 ) TEST DUP .AL/X ., .IMM ;
  339.  
  340. : STOS ( op | AA-AB ) .ME .SIZE ;
  341. : LODS ( op | AC-AD ) .ME .SIZE ;
  342. : SCAS ( op | AE-AF ) .ME .SIZE ;
  343.  
  344. : A0S ( op | A0-AF )
  345.   DUP 2/ 7 ANDD
  346.   EXEC: MOVA MOVA MOVS CMPS .TEST STOS LODS SCAS ;
  347.  
  348. : MOV# ( op | B0-BF )
  349.    MOV DUP 8 ANDD
  350.   IF .16REG ., WIMM EXIT THEN .8REG ., BIMM ;
  351.  
  352. : 80-BF ( op | 80-BF )
  353.   DUP 4 2/S 3 ANDD EXEC: 8MOVS 90S A0S MOV# ;
  354.  
  355. SELF.L LES  SELF.L LDS  SELF.L INTO  SELF.L IRET
  356.  
  357. : RET ( op | C2-C3 CA-CB )
  358.   .ME DUP 8 ANDD IF .FAR THEN
  359.   1 ANDD 0= IF WDISP ( ??? ) ." +SP" THEN ;
  360.  
  361. : .L/L ( op ) 1 ANDD EXEC: LES LDS ;
  362.  
  363. : LES/LDS ( op | C4-C5 )
  364.   DUP .L/L NEXTB .REG ., .MREG 2DROP ;
  365.  
  366. : MOV#R/M ( op | C6-C7 )
  367.   NEXTB DUP $38 ANDD IF .NA1 EXIT THEN
  368.   MOV .MREG ?., ?DISP DROP DUP .IMM .SIZE ;
  369.  
  370. : INT ( op | CC-CD )
  371.   .ME 1 ANDD IF NEXTB ELSE 3 THEN U. ;
  372.  
  373. : INTO/IRET ( op | CE-CF )
  374.   1 ANDD EXEC: INTO IRET ;
  375.  
  376. : C0S ( op | C0-CF )
  377.   DUP 2/ 7 ANDD
  378.   EXEC: .NA RET LES/LDS MOV#R/M .NA RET INT INTO/IRET ;
  379.  
  380. SELF.L ROL  SELF.L ROR  SELF.L RCL  SELF.L RCR
  381. SELF.L SHL  SELF.L SHR  SELF.L SAR
  382.  
  383. : .SHIFTS ( ext )
  384.   3 2/S 7 ANDD EXEC: ROL ROR RCL RCR SHL SHR .NA0 SAR ;
  385.  
  386. : SHIFTS ( op | D0-D3 )
  387.   NEXTB DUP 3 2/S 7 ANDD 6 = IF .NA1 EXIT THEN
  388.   DUP .SHIFTS .MREG DROP 2 ANDD IF ?., CL THEN ;
  389.  
  390. : AAM ( op | D4 ) .ME NEXTB 2DROP ;
  391. : AAD ( op | D5 ) .ME NEXTB 2DROP ;
  392. : XLAT ( op | D7 ) .ME DROP ;
  393.  
  394. : ESC ( op ext - op ext | D8-DF )
  395.   .ME 2DUP $38 ANDD SWAP 7 ANDD ORR . .MREG ;
  396.  
  397. DEFER ESCCODE   ' ESC IS ESCCODE
  398.  
  399. : D0S ( op | D0-DF )
  400.   DUP 8 ANDD IF NEXTB ESCCODE 2DROP EXIT THEN
  401.   DUP 7 ANDD
  402.   EXEC: SHIFTS SHIFTS SHIFTS SHIFTS AAM AAD .NA XLAT ;
  403.  
  404. SELF.L LOOPE  SELF.L LOOP  SELF.L JCXZ  SELF.L LOOPNE
  405.  
  406. : .LOOP ( op )
  407.   3 ANDD EXEC: LOOPNE LOOPE LOOP JCXZ ;
  408.  
  409. : LOOPS ( op | E0-E3 )
  410.   .LOOP NEXTB SEXT CP @ + .SYMBOL ;
  411.  
  412. SELF.L IN  SELF.L OUT  SELF.L JMP
  413.  
  414. : IO# ( op | E4-E7 )
  415.    DUP 2 ANDD
  416.   IF OUT BIMM .AL/X EXIT THEN IN .AL/X ., BIMM ;
  417.  
  418. : IOX ( op | EC-EF )
  419.    DUP 2 ANDD
  420.   IF OUT DX ., .AL/X EXIT THEN IN .AL/X ., DX ;
  421.  
  422. : .CALL ( op )
  423.   3 ANDD EXEC: CALL JMP JMP JMP ;
  424.  
  425. : CALLS ( op | E8-EB )
  426.    DUP .CALL DUP 2 ANDD
  427.   IF DUP 1 ANDD
  428.    IF NEXTB SEXT CP @ + .SYMBOL
  429.    ELSE INTER
  430.    THEN
  431.   ELSE NEXTW CP @ + .SYMBOL
  432.    ( make smart about DEBUG's tricks and E0 )
  433.    DUP $0E9 = CP @ C@ $0E0 = ANDD IF 1 CP +! THEN
  434.   THEN DROP ;
  435.  
  436. : E0S ( op | E0-EF )
  437.   DUP 2 2/S 3 ANDD EXEC: LOOPS IO# CALLS IOX ;
  438.  
  439. : FTEST ( op | F6-F7 )
  440.   TEST .MREG ?., ?DISP DROP DUP .IMM .SIZE ;
  441.  
  442. SELF.L NOT  SELF.L NEG  SELF.L MUL  SELF.L IMUL
  443. SELF.L DIV  SELF.L IDIV SELF.L REP  SELF.L REPNE
  444. SELF.L LOCK SELF.L HLT  SELF.L CMC  SELF.L CLC
  445. SELF.L STC  SELF.L CLI  SELF.L STI  SELF.L CLD
  446. SELF.L STD  SELF.L INC  SELF.L DEC  SELF.L PUSH
  447.  
  448. : .MUL/DIV ( ext )
  449.   3 2/S 3 ANDD EXEC: MUL IMUL DIV IDIV ;
  450.  
  451. : MUL/DIV ( op ext | F6-F7 )
  452.   DUP .MUL/DIV .MREG 2DROP ;
  453.  
  454. : .NOT/NEG ( ext )
  455.   3 2/S 1 ANDD EXEC: NOT NEG ;
  456.  
  457. : NOT/NEG ( op ext | F6-F7 )
  458.   DUP .NOT/NEG .MREG 2DROP ;
  459.  
  460. : F6-F7S ( op | F6-F7 )
  461.   NEXTB DUP 3 2/S 7 ANDD
  462.   EXEC: FTEST .NA1 NOT/NEG NOT/NEG
  463.    MUL/DIV MUL/DIV MUL/DIV MUL/DIV ;
  464.  
  465. : .FES ( ext )
  466.   3 2/S 1 ANDD EXEC: INC DEC ;
  467.  
  468. : FES ( op | FE )
  469.   NEXTB DUP 3 2/S 6 ANDD IF .NA1 EXIT THEN
  470.   DUP .FES .MREG 2DROP ;
  471.  
  472. : .FCALL/JMP ( ext )
  473.   2/ 1 ANDD EXEC: JMP CALL ;
  474.  
  475. : FCALL/JMP ( op ext | FF )
  476.    DUP 3 2/S DUP .FCALL/JMP 1 ANDD
  477.   IF .FAR THEN .MREG 2DROP ;
  478.  
  479. : FPUSH ( op ext | FF )
  480.   DUP 4 ANDD IF PUSH .MREG 2DROP EXIT THEN .NA1 ;
  481.  
  482. : .FINC ( op ext )
  483.   3 2/S 1 ANDD EXEC: INC DEC ;
  484.  
  485. : FINC ( op ext | FF )
  486.   DUP .FINC .MREG $0C7 ANDD 6 = IF WORD THEN DROP ;
  487.  
  488. : FFS ( op | FF )
  489.   NEXTB DUP 4 2/S 3 ANDD
  490.   EXEC: FINC FCALL/JMP FCALL/JMP FPUSH ;
  491.  
  492. : .NAF1 ( a - a ) DUMPSEG @ OVER C@L .NA ;
  493. : F0S ( op | F0-FF )
  494.   DUP 15 ANDD DUP 7 ANDD 6 < IF NIP THEN
  495.   EXEC: LOCK .NAF1 REPNE REP HLT CMC F6-F7S F6-F7S
  496.    CLC STC CLI STI CLD STD FES FFS ;
  497.  
  498. : C0-FF ( op | C0-FF )
  499.   DUP 4 2/S 3 ANDD EXEC: C0S D0S E0S F0S ;
  500.  
  501. : .INST ( op )
  502.   255 ANDD DUP 6 2/S
  503.   EXEC: 00-3F 40-7F 80-BF C0-FF ;
  504.  
  505. : INST \ display opcode at ip  advancing as needed
  506.         2 SPACES NEXTB .INST OPS @ CP +!  OPS OFF  DISP OFF ;
  507.  
  508. 0 VALUE STOPNOW
  509.  
  510. : .CODE-NAME    ( --- )
  511.                 CR ." CODE " CP @ >NAME .ID| CR ;
  512.  
  513. : ?@NAME        ( --- F1 )
  514.                 DUMPSEG @ ?CS: =
  515.                 IF      CP @ >NAME [ ' NO-NAME >NAME ] LITERAL XORR
  516.                 ELSE    FALSE
  517.                 THEN  ;
  518.  
  519. : BASE.R ( n n ) BASE @ 16 = + U.R ;
  520.  
  521. : DUMP| ( a n ) BOUNDS DO I TC@ 4 BASE.R LOOPP ;
  522.  
  523. : TYPE_ ( a n )
  524.    BOUNDS
  525.   DO I TC@ 127 ANDD DUP ( ASCII ~ 1+ BLANK ) 127 32 WITHIN
  526.    IF DROP ASCII _ THEN EMIT
  527.   LOOPP ;
  528.  
  529. FORTH DEFINITIONS
  530.  
  531. : DM            ( a - a' )      \ Display Memory
  532.                 [ DIS8086 ]
  533.                 SAVESTATE
  534.                 BEGIN   CR DUMPSEG @ 5 BASE.R ." :"
  535.                         DUP 5 BASE.R ." : "   BASE @ 2DUP DUMP|
  536.                         2 SPACES 2DUP TYPE_ +
  537.                         ?KEYPAUSE
  538.                 AGAIN   ;
  539.  
  540. : DIS           ( a )           \ disassemble from address
  541.                 [ DIS8086 ]
  542.                 CP !
  543.                 SAVESTATE
  544.                 HEX
  545.                 OFF> STOPNOW
  546.                 CR ?@NAME
  547.                 IF      .CODE-NAME
  548.                 THEN
  549.                 BEGIN   CP @  INST
  550.                         37 COL ." \" DUMPSEG @ 5 U.R DUP 5 U.R
  551.                         CP @ OVER - 2DUP SPACE DUMP| 69 COL TYPE_
  552.                         ?STACK CR
  553.                         ?@NAME PRINTING @ ANDD 0=
  554.                         KEY?    IF      KEY 27 <> DUP
  555.                                         IF      DROP KEY 27 <>
  556.                                         THEN    ANDD
  557.                                 THEN
  558.                 WHILE   ?@NAME IF .CODE-NAME THEN
  559.                 REPEAT  ;
  560.  
  561. \ Locate existing INTerrupts
  562. CODE #INT2@ ( int# - seg off )
  563.   POP AX        \ int#
  564.   MOV AH, # $35 \ cmd
  565.   PUSH ES       \ save ES
  566.   INT $21       \ DOS
  567.   POP AX        \ get ES
  568.   PUSH ES       \ seg
  569.   PUSH BX       \ off
  570.   MOV ES, AX    \ restore ES
  571.   NEXT
  572. END-CODE
  573.  
  574. : IDIS ( int# ) #INT2@ SWAP =SEG DIS ;
  575.  
  576. : SEEN ( a ) [ HIDDEN ]
  577.    ?CS: =SEG  RELOC OFF
  578.    DUP @REL>ABS DEFINITION-CLASS MAX-CLASSES =
  579.   IF DUP DOES? NIP 0= IF DIS EXIT THEN
  580.   THEN (SEE) ;
  581.  
  582. : SEE ( name ) ' SEEN ;
  583.  
  584. : TASK ;
  585.  
  586. CR .( DIS8086 LOADED )
  587.  
  588.