Annotation of gforth/arch/8086/asm.fs, revision 1.2
1.1 pazsan 1: \ **************************************************************
2: \ File: ASM.FS
3: \ 8086-Assembler for PC
4: \ Autor: Klaus Kohl (adaptet from volksFORTH_PC)
5: \ Log: 30.07.97 KK: file generated
6: \
7: \ * Register using see PRIMS.FS
1.2 ! pazsan 8: \ This file is in the public domain, like the original volksForth
1.1 pazsan 9:
10:
11: include asm/basic.fs
12:
13: also Assembler Definitions
14:
15: : | ;
16: : restrict ;
17: : u2/ 1 rshift ;
18: : 8/ 3 rshift ;
19: : 8* 3 lshift ;
20: : case? over = IF drop TRUE ELSE FALSE THEN ;
21: : (0< $8000 and $8000 = ;
22:
23: \ 8086 registers
24: 0 Constant ax 1 Constant cx 2 Constant dx 3 Constant bx
25: 4 Constant sp 5 Constant bp 6 Constant si 7 Constant di
26: 8 Constant al 9 Constant cl $a Constant dl $b Constant bl
27: $c Constant ah $d Constant ch $e Constant dh $f Constant bh
28:
29: $100 Constant es $101 Constant cs
30: $102 Constant ss $103 Constant ds
31:
32: | Variable isize ( specifies Size by prefix)
33: | : Size: ( n -- ) Create c, Does> c@ isize ! ;
34: 0 Size: byte 1 Size: word word 2 Size: far
35:
36:
37: \ 8086 Assembler System variables ( 10.08.90/kk )
38: | Variable direction \ 0 reg>EA, -1 EA>reg
39: | Variable size \ 1 word, 0 byte, -1 undefined
40: | Variable displaced \ 1 direct, 0 nothing, -1 displaced
41: | Variable displacement
42:
43: | : setsize isize @ size ! ;
44: | : long? ( n -- f ) $FF80 and dup (0< invert ?exit $FF80 xor ;
45: | : ?range dup long? abort" out of range" ;
46: | : wexit rdrop word ;
47: | : moderr word true Abort" invalid" ;
48: | : ?moderr ( f -- ) IF moderr THEN ;
49: | : ?word size @ 1- ?moderr ;
50: | : far? ( -- f ) size @ 2 = ;
51:
52:
53: \ 8086 addressing modes ( 24.05.91/KK )
54: | Create (ea 7 c, 0 c, 6 c, 4 c, 5 c,
55: | : () ( 8b1 -- 8b2 )
56: 3 - dup 4 u> over 1 = or ?moderr (ea + c@ ;
57:
58: -1 Constant # $c6 Constant #) -1 Constant c*
59:
60: : ) ( u1 -- u2 )
61: () 6 case? IF 0 $86 exit THEN $C0 or ;
62: : I) ( u1 u2 -- u3 ) + 9 - dup 3 u> ?moderr $C0 or ;
63:
64: : D) ( n u1 -- n u2 )
65: () over long? IF $40 ELSE $80 THEN or ;
66: : DI) ( n u1 u2 -- n u3 )
67: I) over long? IF $80 ELSE $40 THEN xor ;
68:
69: \ 8086 Registers and addressing modes ks 25 mai 87
70:
71: | : displaced? ( [n] u1 -- [n] u1 f )
72: dup #) = IF 1 exit THEN
73: dup $C0 and dup $40 = swap $80 = or ;
74:
75: | : displace ( [n] u1 -- u1 )
76: displaced? ?dup
77: IF displaced @ ?moderr displaced ! swap displacement ! THEN ;
78:
79: | : rmode ( u1 -- u2 )
80: 1 size ! dup 8 and
81: IF size off $FF07 and THEN ;
82:
83: | : mmode? ( 9b - 9b f) dup $C0 and ;
84:
85: | : rmode? ( 8b1 - 8b1 f) mmode? $C0 = ;
86:
87:
88: \ 8086 decoding addressing modes ks 25 mai 87
89: | : 2address ( [n] source [displ] dest -- 15b / [n] 16b )
90: size on displaced off dup # = ?moderr mmode?
91: IF displace False ELSE rmode True THEN direction !
92: >r # case? IF r> $80C0 xor size @ 1+ ?exit setsize exit
93: THEN direction @
94: IF r> 8* >r mmode? IF displace
95: ELSE dup 8/ 1 and size @ = ?moderr $FF07 and THEN
96: ELSE rmode 8*
97: THEN r> or $C0 xor ;
98:
99: | : 1address ( [displ] 9b -- 9b )
100: # case? ?moderr size on displaced off direction off
101: mmode? IF displace setsize ELSE rmode THEN $C0 xor ;
102:
103:
104: \ 8086 assembler ks 25 mai 87
105: | : immediate? ( u -- u f ) dup (0< ;
106:
107: | : nonimmediate ( u -- u ) immediate? ?moderr ;
108:
109: | : r/m 7 and ;
110:
111: | : reg $38 and ;
112:
113: | : ?akku ( u -- u ff / tf ) dup r/m 0= dup IF nip THEN ;
114:
115: | : smode? ( u1 -- u1 ff / u2 tf ) dup $F00 and
116: IF dup $100 and IF dup r/m 8* swap reg 8/
117: or $C0 or direction off
118: THEN True exit
119: THEN False ;
120:
121: \ 8086 Registers and addressing modes ks 25 mai 87
122: | : w, size @ or X c, ;
123:
124: | : dw, size @ or direction @ IF 2 xor THEN X c, ;
125:
126: | : ?word, ( u1 f -- ) IF X , exit THEN X c, ;
127:
128: | : direct,
129: displaced @
130: IF displacement @ dup long? displaced @ 1+ or ?word, THEN ;
131:
132: | : r/m, X c, direct, ;
133:
134: | : data, size @ ?word, ;
135:
136:
137:
138: \ 8086 Arithmetic instructions ( 24.05.91/KK )
139: | : Arith: ( code -- )
140: Create [ FORTH ] , [ Assembler ]
141: Does> @ >r 2address immediate?
142: IF rmode? IF ?akku IF r> size @
143: IF 5 or X c, X , wexit THEN
144: 4 or X c, X c, wexit THEN THEN
145: r@ or $80 size @ or r> (0<
146: IF size @ IF 2 pick long? 0= IF 2 or size off THEN
147: THEN THEN X c, X c, direct, data, wexit
148: THEN r> dw, r/m, wexit ;
149:
150: $8000 Arith: add, $0008 Arith: or,
151: $8010 Arith: adc, $8018 Arith: sbb,
152: $0020 Arith: and, $8028 Arith: sub,
153: $0030 Arith: xor, $8038 Arith: cmp,
154:
155: \ 8086 move push pop ( 24.05.91/KK )
156: : mov,
157: 2address immediate?
158: IF rmode? IF r/m $B0 or size @ IF 8 or THEN
159: X c, data, wexit
160: THEN $C6 w, r/m, data, wexit
161: THEN 6 case? IF $A2 dw, direct, wexit THEN
162: smode? IF $8C direction @ IF 2 or THEN X c, r/m, wexit
163: THEN $88 dw, r/m, wexit ;
164:
165: | : pupo
166: >r 1address ?word
167: smode? IF reg 6 r> IF 1+ THEN or X c, wexit THEN
168: rmode? IF r/m $50 or r> or X c, wexit THEN
169: r> IF $8F ELSE $30 or $FF THEN X c, r/m, wexit ;
170:
171: : push, 0 pupo ; : pop, 8 pupo ;
172:
173: \ 8086 inc & dec , effective addresses ( 24.05.91/KK )
174: | : inc/dec
175: >r 1address rmode?
176: IF size @ IF r/m $40 or r> or X c, wexit THEN
177: THEN $FE w, r> or r/m, wexit ;
178:
179: : dec, 8 inc/dec ; : inc, 0 inc/dec ;
180:
181: | : EA: ( code -- )
182: Create c,
183: Does> >r 2address nonimmediate
184: rmode? direction @ 0= or ?moderr r> c@ X c, r/m, wexit ;
185:
186: $c4 EA: les, $8d EA: lea, $c5 EA: lds,
187:
188:
189: \ 8086 xchg segment prefix ( 24.05.91/KK )
190: : xchg,
191: 2address nonimmediate rmode?
192: IF size @ IF dup r/m 0=
193: IF 8/ true ELSE dup $38 and 0= THEN
194: IF r/m $90 or X c, wexit THEN
195: THEN THEN $86 w, r/m, wexit ;
196:
197: | : 1addr: ( code -- )
198: Create c,
199: Does> c@ >r 1address $F6 w, r> or r/m, wexit ;
200:
201: $10 1addr: com, $18 1addr: neg,
202: $20 1addr: mul, $28 1addr: imul,
203: $38 1addr: idiv, $30 1addr: div,
204:
205: : seg, ( 8b -)
206: $100 xor dup $FFFC and ?moderr 8* $26 or X c, ;
207:
208: \ 8086 test not neg mul imul div idiv ( 24.05.91/KK )
209: : test,
210: 2address immediate?
211: IF rmode? IF ?akku IF $a8 w, data, wexit THEN THEN
212: $f6 w, r/m, data, wexit
213: THEN $84 w, r/m, wexit ;
214:
215: | : in/out
216: >r 1address setsize
217: $C2 case? IF $EC r> or w, wexit THEN
218: 6 - ?moderr $E4 r> or w, displacement @ X c, wexit ;
219:
220: : out, 2 in/out ; : in, 0 in/out ;
221:
222: : int, 3 case? IF $cc X c, wexit THEN $cd X c, X c, wexit ;
223:
224:
225: \ 8086 shifts and string instructions ( 24.05.91/KK )
226: | : Shifts: ( code -- )
227: Create c,
228: Does> c@ >r C* case? >r 1address
229: r> direction ! $D0 dw, r> or r/m, wexit ;
230:
231: $00 Shifts: rol, $08 Shifts: ror,
232: $10 Shifts: rcl, $18 Shifts: rcr,
233: $20 Shifts: shl, $28 Shifts: shr,
234: $38 Shifts: sar, ' shl, Alias sal,
235:
236: | : Str: ( code -- ) Create c,
237: Does> c@ setsize w, wexit ;
238:
239: $a6 Str: cmps, $ac Str: lods, $a4 Str: movs,
240: $ae Str: scas, $aa Str: stos,
241:
242: \ implied 8086 instructions ( 24.05.91/KK )
243: : Byte: ( code -- )
244: Create c,
245: Does> c@ X c, ;
246: : Word: ( code -- )
247: Create [ FORTH ] , [ Assembler ]
248: Does> @ X , ;
249:
250: $37 Byte: aaa, $ad5 Word: aad, $ad4 Word: aam,
251: $3f Byte: aas, $98 Byte: cbw, $f8 Byte: clc,
252: $fc Byte: cld, $fa Byte: cli, $f5 Byte: cmc,
253: $99 Byte: cwd, $27 Byte: daa, $2f Byte: das,
254: $f4 Byte: hlt, $ce Byte: into, $cf Byte: iret,
255: $9f Byte: lahf, $f0 Byte: lock, $90 Byte: nop,
256: $9d Byte: popf, $9c Byte: pushf, $9e Byte: sahf,
257: $f9 Byte: stc, $fd Byte: std, $fb Byte: sti,
258: $9b Byte: wait, $d7 Byte: xlat,
259: $c3 Byte: ret, $cb Byte: lret,
260: $f2 Byte: rep, $f2 Byte: 0<>rep, $f3 Byte: 0=rep,
261:
262: \ 8086 jmp call conditions ( 24.05.91/KK )
263: | : jmp/call
264: >r setsize # case?
265: IF far? IF r> IF $EA ELSE $9A THEN X c, swap X , X , wexit
266: THEN X here X cell+ - r>
267: IF dup long? 0= IF $EB X c, X c, wexit THEN $E9
268: ELSE $E8 THEN X c, 1- X , wexit
269: THEN 1address $FF X c, $10 or r> +
270: far? IF 8 or THEN r/m, wexit ;
271: : call, 0 jmp/call ; : jmp, $10 jmp/call ;
272:
273: $75 Constant 0= $74 Constant 0<> $79 Constant 0<
274: $78 Constant 0>= $7d Constant < $7c Constant >=
275: $7f Constant <= $7e Constant > $73 Constant u<
276: $72 Constant u>= $77 Constant u<= $76 Constant u>
277: $71 Constant ov $70 Constant nov $e1 Constant <>c0=
278: $e2 Constant c0= $e0 Constant ?c0= $e3 Constant C0<>
279:
280: \ 8086 conditional branching ( 24.05.91/KK )
281: : +ret, $c2 X c, X , ;
282: : +lret, $ca X c, X , ;
283:
284: : IF, X , X here 1- ;
285: : THEN, X here over 1+ - ?range swap X c! ;
286: : ELSE, $eb IF, swap THEN, ;
287: : WHILE, IF, swap ;
288: : BEGIN, X here ;
289: : UNTIL, X c, X here 1+ - ?range X c, ;
290: : AGAIN, $eb UNTIL, ;
291: : REPEAT, AGAIN, THEN, ;
292:
293: : j, 1 xor UNTIL, ;
294:
295:
296: \ (Code)-8086 (End-Code)-8086
297: : (Code)-8086
298: (code)-1 ; ' (Code)-8086 IS (code)
299:
300: : (End-Code)-8086
301: (end-code)-1 ; ' (End-Code)-8086 IS (end-code)
302:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to asm.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / arch / 8086