Annotation of gforth/arch/386/asm.fs, revision 1.2
1.1 anton 1: \ asm386.fth
2: \ Andrew McKewan
3: \ mckewan@netcom.com
4:
5: \ 80386 "subset" assembler.
6: \ Greatly inspired by:
7: \ 1. 32-BIT MINI ASSEMBLER BASED ON riFORTH by Richard Astle
8: \ 2. F83 8086 Assembler by Mike Perry
9:
10: \ This assembler will run under Win32Forth. It was written to support a
11: \ metacompiler so it does not implement the full range of opcodes and
12: \ operands. In particular, it does not support direct memory access
13: \ (i.e. mov [memory],eax ). This is because the Forth system, like
14: \ Win32Forth, uses only relative addresses (index or base+index).
15: \ The syntax is postfix and is similar to F83. Here are some examples:
16: \
17: \ EAX EBX MOV \ move ebx,eax
18: \ 3 # EAX MOV \ mov eax,3
19: \ 100 [EDI] EAX MOV \ mov eax,100[edi]
20: \ 4 [EBX] [ECX] EAX MOV \ mov eax,4[ebx][ecx]
21: \ 16: EAX EBX MOV \ mov bx,ax
22:
23:
1.2 ! anton 24: \ additional words for Gforth port
1.1 anton 25:
1.2 ! anton 26: : w, ( x -- )
! 27: here ! 2 allot ;
1.1 anton 28:
1.2 ! anton 29: base @ get-current ALSO ASSEMBLER DEFINITIONS HEX
1.1 anton 30:
31: \ ---------------------------------------------------------------------
32: \ Defer memory-access words for the metacompiler
33:
34: DEFER HERE FORTH ' HERE ASSEMBLER IS HERE
35: DEFER , FORTH ' , ASSEMBLER IS ,
36: DEFER C, FORTH ' C, ASSEMBLER IS C,
37: DEFER TC@ FORTH ' C@ ASSEMBLER IS TC@
38: DEFER TC! FORTH ' C! ASSEMBLER IS TC!
39:
40:
41: \ ---------------------------------------------------------------------
42: \ Register Fields: 8000 <flags> <sib>
43:
44: \ Flag bits: 0 = size field 1 = DWORD, 0 = BYTE
45: \ 1 = index field 1 = INDEXED MODE
46: \ 2 = sib flag 1 = SIB byte required
47:
48: : REG ( mask off register field ) 7 AND ;
49: : REG? ( reg -- f ) FFFF0200 AND 80000000 = ;
50: : R32? ( reg -- f ) FFFF0300 AND 80000100 = ;
51: : INDEX? ( reg -- f ) FFFF0200 AND 80000200 = ;
52: : SIZE? ( reg -- 0/1 ) 8 RSHIFT 1 AND ;
53: : SIB? ( reg -- f ) 400 AND ;
54:
55: : INDEX ( n -- ) \ create an index register
56: CREATE , DOES> @
57: OVER INDEX?
58: IF REG 3 LSHIFT ( move reg to index field in sib )
59: 400 OR ( set sib flag )
60: SWAP FFFFFFC7 AND OR ( put into sib byte of previous register )
61: THEN ;
62:
63: 80000100 CONSTANT EAX 80000000 CONSTANT AL
64: 80000101 CONSTANT ECX 80000001 CONSTANT CL
65: 80000102 CONSTANT EDX 80000002 CONSTANT DL
66: 80000103 CONSTANT EBX 80000003 CONSTANT BL
67: 80000104 CONSTANT ESP 80000004 CONSTANT AH
68: 80000105 CONSTANT EBP 80000005 CONSTANT CH
69: 80000106 CONSTANT ESI 80000006 CONSTANT DH
70: 80000107 CONSTANT EDI 80000007 CONSTANT BH
71:
72: 80000300 INDEX [EAX]
73: 80000301 INDEX [ECX]
74: 80000302 INDEX [EDX]
75: 80000303 INDEX [EBX]
76: 80000724 INDEX [ESP]
77: 80000305 INDEX [EBP]
78: 80000306 INDEX [ESI]
79: 80000307 INDEX [EDI]
80:
81: 80010000 CONSTANT # ( just different from any register )
82:
83: \ Scaled index mode must have a base register, i.e.
84: \ 0 [EDI] [EAX] *4 ECX MOV
85: : *2 40 OR ;
86: : *4 80 OR ;
87: : *8 C0 OR ;
88:
89: \ ---------------------------------------------------------------------
90: \ Assembler addressing mode bytes
91:
92: VARIABLE SIZE 1 SIZE !
93: : BYTE 0 SIZE ! ;
94: : OP, ( n op -- ) OR C, ;
95: : SIZE, ( op reg -- ) SIZE? OP, ;
96: : SHORT? ( n -- f ) -80 80 WITHIN ;
97: : DISP? ( n reg -- n reg f ) 2DUP REG 5 = ( [EBP] ) OR ;
98:
99: : RR, ( reg reg/op -- ) 3 LSHIFT OR C0 OP, ;
100:
101: : MEM, ( operand [reg] reg -- )
102: 3 LSHIFT >R ( move to reg/opcode field )
103: DUP SIB?
104: IF DISP?
105: IF OVER SHORT?
106: IF R> 44 OP, C, C,
107: ELSE R> 84 OP, C, ,
108: THEN
109: ELSE R> 4 OP, C, DROP ( no displacement )
110: THEN
111: ELSE DISP?
112: IF OVER SHORT?
113: IF R> OR 40 OP, C,
114: ELSE R> OR 80 OP, ,
115: THEN
116: ELSE R> OP, DROP ( no displacement )
117: THEN
118: THEN ;
119:
120: : R/M, ( operand [reg] reg | reg reg -- )
121: OVER REG? IF RR, ELSE MEM, THEN ;
122:
123: : WR/SM, ( r/m reg op -- ) 2 PICK REG?
124: IF 2 PICK SIZE, RR, ELSE SIZE @ OP, MEM, THEN 1 SIZE ! ;
125:
126:
127: \ ---------------------------------------------------------------------
128: \ Opcode Defining Words
129:
130: : CPU ( op -- ) CREATE C, DOES> C@ C, ;
131:
132: 66 CPU 16: \ 16-bit opcode prefix (cannot use with immedate ops)
133: C3 CPU RET
134: F2 CPU REP F2 CPU REPNZ F3 CPU REPZ
135: FC CPU CLD FD CPU STD 99 CPU CDQ
136:
137:
138: : SHORT ( op opex regop -- )
139: CREATE C, C, C,
140: DOES> ( reg | offset [reg] -- ) OVER R32?
141: IF C@ OP, ELSE 1+ COUNT SWAP C@ WR/SM, THEN ;
142:
143: FF 6 50 SHORT PUSH 8F 0 58 SHORT POP
144: FE 0 40 SHORT INC FE 1 48 SHORT DEC
145:
146:
147: : UNARY ( opex -- )
148: CREATE C, DOES> ( reg | offset [reg] ) C@ F6 WR/SM, ;
149:
150: 2 UNARY INV ( INV = Intel's NOT )
151: 3 UNARY NEG 4 UNARY MUL
152: 5 UNARY IMUL 6 UNARY DIV 7 UNARY IDIV
153:
154:
155: \ The following forms are accepted for binary operands.
156: \ Note that immediate to memory is not supported.
157: \ reg reg <op>
158: \ n # reg <op>
159: \ ofs [reg] reg <op>
160: \ reg ofs [reg] <op>
161:
162: : BINARY ( op -- )
163: CREATE C,
164: DOES> C@ 2 PICK # =
165: IF OVER SIZE?
166: IF 81 C, RR, DROP ,
167: ELSE 80 C, RR, DROP C,
168: THEN
169: ELSE 3 LSHIFT
170: OVER INDEX? IF >R ROT R> ELSE 2 OR THEN
171: OVER SIZE, R/M,
172: THEN ;
173:
174: : MOV ( operands... -- )
175: OVER # =
176: IF DUP SIZE? IF B8 OP, DROP , ELSE B0 OP, DROP C, THEN
177: ELSE DUP INDEX? IF ROT 88 ELSE 8A THEN OVER SIZE, R/M,
178: THEN ;
179:
180: : LEA ( reg/mem reg -- ) 8D C, MEM, ;
181:
182: : XCHG ( mr1 reg -- )
183: OVER REG? OVER EAX = AND
184: IF DROP REG 90 OP,
185: ELSE 86 OVER SIZE, R/M, THEN ;
186:
187: ( TEST ... )
188:
189:
190: \ Shift/Rotate syntax:
191: \ eax shl 0 [ecx] [edi] shl
192: \ eax 4 shl 0 [ecx] [edi] 4 shl
193: \ eax cl shl 0 [ecx] [edi] cl shl
194:
195: : SHIFT ( op -- )
196: CREATE C,
197: DOES> C@ OVER CL =
198: IF NIP D2 WR/SM,
199: ELSE OVER 0< ( reg/index)
200: IF D0 WR/SM,
201: ELSE OVER 1 =
202: IF NIP D0 WR/SM,
203: ELSE SWAP >R C0 WR/SM, R> C,
204: THEN
205: THEN
206: THEN ;
207:
208: 0 SHIFT ROL 1 SHIFT ROR 2 SHIFT RCL 3 SHIFT RCR
209: 4 SHIFT SHL 5 SHIFT SHR 7 SHIFT SAR
210:
211: \ String instructions. Precede with BYTE for byte version
212: : STR ( op -- )
213: CREATE C, DOES> C@ SIZE @ OP, 1 SIZE ! ;
214:
215: A4 STR MOVS A6 STR CMPS
216: AA STR STOS AC STR LODS AE STR SCAS
217:
218:
219: \ ---------------------------------------------------------------------
220: \ Relative jumps and calls
221:
222: : OFFSET ( dest source -- offset )
223: 1+ - DUP SHORT? 0= ABORT" branch target out of range" ;
224:
225: : REL8, ( addr -- ) HERE OFFSET C, ;
226: : REL32, ( addr -- ) HERE CELL+ - , ;
227:
228: : REL ( op -- ) CREATE C, DOES> C@ C, REL8, ;
229:
230: 70 REL JO 71 REL JNO 72 REL JB 73 REL JAE
231: 74 REL JE 75 REL JNE 76 REL JBE 77 REL JA
232: 78 REL JS 79 REL JNS 7A REL JPE 7B REL JNP
233: 7C REL JL 7D REL JGE 7E REL JLE 7F REL JG
234: E3 REL JECXZ
235:
236: : JMP ( addr | r/m -- )
237: DUP 0< ( reg/index ) IF FF C, 4 R/M,
238: ELSE DUP HERE 2 + - SHORT? IF EB C, REL8,
239: ELSE E9 C, REL32, THEN THEN ;
240:
241: : CALL ( addr | r/m -- )
242: DUP 0< ( reg/index ) IF FF C, 2 R/M, ELSE E8 C, REL32, THEN ;
243:
244:
245: \ ---------------------------------------------------------------------
246: \ Local labels
247:
248: 10 CONSTANT MAX-LABELS ( adjust as required )
249:
250: : ARRAY CREATE CELLS ALLOT DOES> SWAP CELLS + ;
251:
252: MAX-LABELS ARRAY LABEL-VALUE ( value of label or zero if not resolved )
253: MAX-LABELS ARRAY LABEL-LINK ( linked list of unresolved references )
254:
255: : CLEAR-LABELS ( initialize label arrays )
256: 0 LABEL-VALUE MAX-LABELS CELLS ERASE
257: 0 LABEL-LINK MAX-LABELS CELLS ERASE ; CLEAR-LABELS
258:
259: : CHECK-LABELS ( make sure all labels have been resolved )
260: MAX-LABELS 0
261: DO I LABEL-LINK @ IF CR ." Label " I . ." not resolved" THEN LOOP ;
262:
263: : $: ( n -- ) ( define a label )
264: DUP LABEL-VALUE @ ABORT" Duplicate label"
265: HERE OVER LABEL-LINK @ ?DUP ( any unresolved references? )
266: IF ( n address link )
267: BEGIN DUP TC@ >R ( save offset to next reference )
268: 2DUP OFFSET OVER TC! ( resolve this reference )
269: R@ 100 - + ( go to next reference )
270: R> 0= ( more references? )
271: UNTIL
272: DROP OVER LABEL-LINK OFF ( clear unresolved list )
273: THEN
274: SWAP LABEL-VALUE ! ; ( resolve label address )
275:
276: : $ ( n -- addr ) ( reference a label )
277: DUP LABEL-VALUE @ ( already resolved? )
278: IF LABEL-VALUE @
279: ELSE DUP LABEL-LINK @ ?DUP 0= ( first reference? )
280: IF HERE 1+ THEN 1+ ( link to previous label )
281: HERE 1+ ROT LABEL-LINK ! ( save current label at head of list )
282: THEN ;
283:
284:
285: \ ---------------------------------------------------------------------
286: \ Structured Conditionals
287:
288: 75 CONSTANT 0= 79 CONSTANT 0< 73 CONSTANT U< 76 CONSTANT U>
289: 7D CONSTANT < 7E CONSTANT > 71 CONSTANT OV E3 CONSTANT ECX0<>
290:
291: : NOT 1 XOR ; ( reverse logic of conditional )
292:
293: : IF C, HERE 0 C, ;
294: : THEN HERE OVER OFFSET SWAP TC! ;
295: : ELSE EB IF SWAP THEN ;
296: : BEGIN HERE ;
297: : UNTIL C, REL8, ;
298: : LOOP E2 UNTIL ;
299: : AGAIN EB UNTIL ;
300: : WHILE IF SWAP ;
301: : REPEAT AGAIN THEN ;
302:
303: 0 BINARY ADD 1 BINARY OR 2 BINARY ADC 3 BINARY SBB
304: 4 BINARY AND 5 BINARY SUB 6 BINARY XOR 7 BINARY CMP
305:
306: : RET# ( n -- ) C2 C, W, ;
307: : PUSH# ( n -- ) 68 C, , ;
308:
1.2 ! anton 309: previous set-current decimal base !
1.1 anton 310:
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 / 386