1 line
27 KiB
Plaintext
1 line
27 KiB
Plaintext
\ 8086 assembler - information An 8086 Forth assembler for DX-FORTH Based on F83 assembler \ load block forth definitions hex sys @ system warning @ warning off marker -ASM cr .( loading 8086 Assembler ) 2 #screens 1- thru forth definitions decimal warning ! sys ! \ vocabularies vocabulary ASSEMBLER assembler definitions vocabulary HIDDEN hidden definitions chain assembler 2variable avoc : big? ( n -- flag ) 80 -80 within ; : rel ( a1 a2 -- offs ) 1+ - dup big? abort" branch out of range" ; \ labels #20 constant ml \ max labels #25 constant mf \ max forward references \ arrays :noname ( n -- adr ) count rot * + ; ( xt) dup build lt 1 cells dup c, ml * allot \ labels build ft 2 cells dup c, mf * allot \ fwd refs \ reset labels : !lb ( -- ) 0 lt [ ml cells ] literal erase 0 ft [ mf cells 2* ] literal erase ; !lb \ labels \ resolve all forward references : ?lb ( -- ) mf 0 do i ft 2@ dup if ( fwd ref ) swap lt @ dup 0= abort" unresolved reference" ( target label ) over dup 1- c@ ( opc ) dup 70 80 within over E0 E4 within or over EB = or if ( short ) drop rel swap c! else dup E8 EA within ( call/jmp ) if drop 2+ - swap ! else dup C0 B8 within swap A4 A0 within and ( handle 3/4 byte instr) - ! drop then then else 2drop then loop ; \ labels \ add address to forward ref table : fwd ( a -- ) here 1+ ( skip opcode ) mf 1+ 0 do i mf = abort" too many references" i ft dup @ if drop else tuck ! cell+ ! 0 0 leave then loop 2drop ; \ check label number : ?l ( n -- n ) 1- dup ml 0 within abort" invalid label" ; \ labels assembler definitions hidden \ declare label : $: ( n -- ) ?l lt dup @ abort" duplicate label" here swap ! ; \ get label address : $ ( n -- a ) ?l dup lt @ ( n adr ) dup if nip else swap fwd ( dummy adr ) then ; \ addressing modes 800 constant # 809 constant ) 812 constant [] 80 constant [BX+SI] 89 constant [BX+DI] 92 constant [BP+SI] 9B constant [BP+DI] A4 constant [SI] AD constant [DI] B6 constant [BP] BF constant [BX] aka [BX+SI] [SI+BX] aka [BX+DI] [DI+BX] aka [BP+SI] [SI+BP] aka [BP+DI] [DI+BP] \ registers 00 constant AL 09 constant CL 12 constant DL 1B constant BL 24 constant AH 2D constant CH 36 constant DH 3F constant BH 40 constant AX 49 constant CX 52 constant DX 5B constant BX 64 constant SP 6D constant BP 76 constant SI 7F constant DI C0 constant ES C9 constant CS D2 constant SS DB constant DS \ operators hidden definitions : reg constant does> c@ swap FFC0 and = 1 and ; ( 00 reg 8? ) 40 reg 16? 80 reg m? C0 reg s? 0 value siz ( byte/word ) 0 value isf ( far on/off ) : !siz ( -- ) 1 to siz ; \ default is WORD : !seg ( -- ) 0 to isf ; \ default is FAR off \ operators : r? ( n -- flag ) 0FFC0 and 80 < ; : low ( n -- mask ) 7 and ; : mid ( n -- mask ) 38 and ; : op, ( n op -- ) or c, ; : w, ( op mr -- ) 16? op, ; : siz, ( op -- op' ) siz op, ; : ,c, ( n f -- ) if , else c, then ; : r, ( mr1 mr2 -- ) mid swap low or C0 op, ; : esc, ( m -- ) D8 op, ; \ operators : m, ( disp mr m -- ) mid over ) = if 6 op, drop , else over low or -rot [BP] = over 0= and if swap 40 op, c, else tuck big? if 80 op, , else over if 40 op, c, else op, then then then then ; : ow, ( mr op -- mr ) over w, ; : wm, ( disp mem reg op -- ) ow, m, ; : rm, ( mr reg -- ) over r? if r, else m, then ; : wr, ( r/m r op -- ) 2 pick dup r? if w, r, else drop siz, m, then !siz ; : far? ( n1 -- n2 ) isf or !seg ; \ instruction class : m1 constant does> c@ c, ; : m2 constant does> c@ c, 0A c, ; : m3 constant does> c@ c, dup if here rel then c, ; : m4 constant does> c@ c, m, ; : m5 constant does> c@ siz, !siz ; : m7 constant does> c@ F6 wr, ; : m8 constant does> c@ >r dup r? if dup DX = if swap then else rot then 16? r> or swap # = if c, c, else 08 op, then ; : m9 constant does> c@ over 16? if 40 or swap low op, else FE wr, then ; : ma constant does> c@ over CL = if nip D2 else over 1 = if nip then D0 then wr, ; \ instruction class : mb constant does> c@ dup far? c, 1 and 0= if , then ; : mc constant does> over ) = if nip c@ isf if 1 and if EA else 9A then c, swap , , !seg else swap here - 2- swap 2dup 1 and swap big? 0= and if 2 op, c, else c, 1- , then then else over [] = if nip ) swap then 0FF c, 1+ c@ far? rm, then ; : md constant , does> over r? if c@ swap low op, else 1+ over s? if c@ low swap mid op, else count swap c@ c, m, then then ; \ instruction class : me constant does> c@ >r dup r? if over r? if r> ow, swap r, else over dup m? swap ) = or if r> 2 or wm, else ( #) nip dup low 0= ( acc?) if r> 4 or ow, 16? ,c, else over big? over 16? 2dup and -rot swap invert 2 and or 80 op, swap low C0 or r> op, ,c, then then then else ( mem) rot dup r? if r> wm, else ( #) drop 2 pick big? dup invert 2 and 80 or siz, -rot r> m, siz and ,c, !siz then then ; \ mnemonics assembler definitions hidden : TEST ( src dst -- ) dup r? if over r? if 84 ow, swap r, else over dup m? swap ) = or if 84 wm, else ( #) nip dup low 0= ( acc?) if A8 ow, else F6 ow, dup low C0 op, then 16? ,c, then then else ( mem) rot dup r? if 84 wm, else ( #) drop F6 siz, 0 m, siz ,c, !siz then then ; \ mnemonics : MOV ( src dst -- ) dup s? if 8E c, rm, else dup r? if over ) = over low 0= and if A0 swap w, drop , else over s? if swap 8C c, r, else over # = if nip dup 16? 8 * swap low over or B0 op, ,c, else 8A ow, rm, then then then else ( mem) rot dup s? if 8C c, m, else dup # = if drop C6 siz, 0 m, siz ,c, !siz else over ) = over low 0= and if A2 swap w, drop , else 88 ow, rm, then then then then then ; \ mnemonics : XCHG ( mr1 mr2 -- ) dup r? if over r? if over AX = if swap then dup AX = if drop low 90 op, end then else rot then dup 16? to siz 86 wr, ; : ESC ( src ext-opc -- ) low D8 op, rm, ; : INT ( n -- ) CD over 3 = if nip 1- else c, then c, ; \ : SEG ( seg -- ) mid 26 op, ; \ mnemonics 26 m1 ES: 27 m1 DAA 2E m1 CS: 2F m1 DAS 36 m1 SS: 37 m1 AAA 3E m1 DS: 3F m1 AAS 90 m1 NOP 98 m1 CBW 99 m1 CWD 9B m1 WAIT 9C m1 PUSHF 9D m1 POPF 9E m1 SAHF 9F m1 LAHF CE m1 INTO CF m1 IRET D7 m1 XLAT F0 m1 LOCK F2 m1 REPNZ F3 m1 REPZ aka REPZ REP F4 m1 HLT F5 m1 CMC F8 m1 CLC F9 m1 STC FA m1 CLI FB m1 STI FC m1 CLD FD m1 STD D4 m2 AAM D5 m2 AAD \ mnemonics 70 m3 JO 71 m3 JNO 72 m3 JC aka JC JB 73 m3 JNC aka JNC JNB 74 m3 JZ 75 m3 JNZ 76 m3 JNA 77 m3 JA 78 m3 JS 79 m3 JNS 7A m3 JPE 7B m3 JPO 7C m3 JL 7D m3 JNL 7E m3 JNG 7F m3 JG E0 m3 LOOPNZ E1 m3 LOOPZ E2 m3 LOOP E3 m3 JCXZ EB m3 JU 8D m4 LEA C4 m4 LES C5 m4 LDS A4 m5 MOVS A6 m5 CMPS AA m5 STOS AC m5 LODS AE m5 SCAS \ mnemonics 10 m7 NOT 18 m7 NEG 20 m7 MUL 28 m7 IMUL 30 m7 DIV 38 m7 IDIV E4 m8 IN E6 m8 OUT 00 m9 INC 08 m9 DEC 00 ma ROL 08 ma ROR 10 ma RCL 18 ma RCR 20 ma SHL 28 ma SHR 38 ma SAR C2 mb +RET C3 mb RET 10E8 mc CALL 20E9 mc JMP 8F07 58 md POP FF36 50 md PUSH 00 me ADD 08 me OR 10 me ADC 18 me SBB 20 me AND 28 me SUB 30 me XOR 38 me CMP \ interface \ modifiers : BYTE ( -- ) 0 to siz ; \ BYTE operation : FAR ( -- ) 8 to isf ; \ FAR operation \ macros etc : NEXT !siz lods ax jmp ; \ in-line NEXT : 1PUSH 'next 1- ) jmp ; \ push AX jmp NEXT : 2PUSH 'next 2- ) jmp ; \ push DX then AX jmp NEXT : USER# ( user -- offs ) up @ - ; \ USER offset number : [UP] up ) di mov user# # di add 0 [di] ; \ USER addr \ interface \ kernel address ' next 1+ dup @ + 2+ constant DOCOL ( -- adr ) ' exit 9 + constant EXIT1 ( -- adr ) ' ticks 1+ dup @ + 2+ constant TOD ( -- adr ) ' wait-tick 1+ dup @ + 2+ constant TSYNC ( -- adr ) ' upcase 2+ dup @ + 2+ constant UPC ( -- adr ) \ interface \ reset/check labels and stack point : READY ( -- sp ) csp @ !lb !csp ; : CHECK ( sp -- ) ?csp ?lb csp ! ; : ASM] avoc @ context ! ; : END-CODE ( -- ) ?exec check asm] smudge ; \ end macro definition : ENDM ( sys -- ) postpone ; avoc 2@ context 2! sys ! ; immediate \ interface \ enter high-level forth, saving SI : C: ( -- ) docol ) call asm] ] ; forth definitions assembler hidden : [ASM ( -- ) context @ avoc ! assembler !siz !seg postpone [ ; immediate : LABEL ( -- ) ?exec create smudge postpone [asm ready ; immediate : CODE ( -- ) postpone label 3 -allot ; immediate \ interface : ;CODE ( -- ) postpone (;code) postpone [asm ready ; immediate \ begin macro definition : MACRO ( -- sys ) sys @ context 2@ avoc 2! assembler definitions system : ; \ exit high-level forth, restoring SI : ;C ( -- ) exit1 compile, postpone [asm ; immediate |