Annotation of gforth/arch/386/asm.fs, revision 1.13
1.4 pazsan 1: \ *** Assembler for the Intel i486 *** 07nov92py
1.5 pazsan 2:
3: \ Copyright (C) 1992-2000 by Bernd Paysan
4:
1.13 ! anton 5: \ Copyright (C) 2000,2001,2003,2007 Free Software Foundation, Inc.
1.5 pazsan 6:
7: \ This file is part of Gforth.
8:
9: \ Gforth is free software; you can redistribute it and/or
10: \ modify it under the terms of the GNU General Public License
1.12 anton 11: \ as published by the Free Software Foundation, either version 3
1.5 pazsan 12: \ of the License, or (at your option) any later version.
13:
14: \ This program is distributed in the hope that it will be useful,
15: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
16: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: \ GNU General Public License for more details.
18:
19: \ You should have received a copy of the GNU General Public License
1.12 anton 20: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.4 pazsan 21: \
22: \ The syntax is reverse polish. Source and destination are
23: \ reversed. Size prefixes are used instead of AX/EAX. Example:
24: \ Intel gives
25: \ mov ax,bx .w bx ax mov
26: \ mov eax,[ebx] .d bx ) ax mov
27: \ add eax,4 .d 4 # ax add
28: \
29: \ in .86 mode .w is the default size, in .386 mode .d is default
30: \ .wa and .da change address size. .b, .w(a) and .d(a) are not
31: \ switches like in my assem68k, they are prefixes.
32: \ [A-D][L|H] implicitely set the .b size. So
33: \ AH AL mov
34: \ generates a byte move. Sure you need .b for memory operations
35: \ like .b ax ) inc which is inc BYTE PTR [eAX]
36:
37: \ 80486 Assembler Load Screen 21apr00py
38:
39: base @ get-current ALSO ASSEMBLER DEFINITIONS also
40:
41: &8 base !
42:
43: : [F] Forth ; immediate
44: : [A] Assembler ; immediate
45:
46: \ Assembler Forth words 11mar00py
47:
48: : user' ' >body @ ; immediate
49: : case? ( n1 n2 -- t / n1 f )
50: over = IF drop true ELSE false THEN ;
51:
52: \ Code generating primitives 07mar93py
53:
54: Variable >codes
55: : (+rel ;
1.9 pazsan 56: Create nrc ' c, A, ' here A, ' allot A, ' c! A, ' (+rel A,
1.4 pazsan 57:
58: : nonrelocate nrc >codes ! ; nonrelocate
59:
60: : >exec Create dup c, cell+
61: Does> c@ >codes @ + perform ;
62:
63: 0
64: >exec , >exec here >exec allot >exec c!
65: >exec +rel
66: drop
67:
68: \ Stack-Buffer fr Extra-Werte 22dec93py
69:
70: Variable ModR/M Variable ModR/M#
71: Variable SIB Variable SIB#
72: Variable disp Variable disp#
73: Variable imm Variable imm#
74: Variable Aimm? Variable Adisp?
75: Variable byte? Variable seg
76: Variable .asize Variable .anow
77: Variable .osize Variable .onow
78: : pre- seg off .asize @ .anow ! .osize @ .onow ! ;
79: : sclear pre- Aimm? off Adisp? off
80: ModR/M# off SIB# off disp# off imm# off byte? off ;
81:
82: : .b 1 byte? ! imm# @ 1 min imm# ! ;
83:
84: : .w .onow off ; : .wa .anow off ;
85: : .d .onow on ; : .da .anow on ;
86:
87: \ Extra-Werte compilieren 01may95py
88: : bytes, ( nr x n -- )
89: 0 ?DO over 0< IF +rel swap 1+ swap THEN dup , $8 rshift
90: LOOP 2drop ;
91: : opcode, ( opcode -- )
92: .asize @ .anow @ <> IF $67 , THEN
93: .osize @ .onow @ <> IF $66 , THEN
94: seg @ IF seg @ , THEN , pre- ;
95: : finish ( opcode -- ) opcode,
96: ModR/M# @ IF ModR/M @ , THEN
97: SIB# @ IF SIB @ , THEN
98: Adisp? @ disp @ disp# @ bytes,
99: Aimm? @ imm @ imm# @ bytes, sclear ;
100: : finishb ( opcode -- ) byte? @ xor finish ;
101: : 0F, $0F opcode, ;
102: : finish0F ( opcode -- ) 0F, finish ;
103:
104: \ Register 29mar94py
105:
106: : Regs ( mod n -- ) FOR dup Constant 11 + NEXT drop ;
107: : breg ( reg -- ) Create c, DOES> c@ .b ;
108: : bregs ( mod n -- ) FOR dup breg 11 + NEXT drop ;
109: : wadr: ( reg -- ) Create c, DOES> c@ .wa ;
110: : wadr ( mod n -- ) FOR dup wadr: 11 + NEXT drop ;
111: 0 7 wadr [BX+SI] [BX+DI] [BP+SI] [BP+DI] [SI] [DI] [BP] [BX]
112: 300 7 regs AX CX DX BX SP BP SI DI
113: 300 7 bregs AL CL DL BL AH CH DH BH
114: 2300 5 regs ES CS SS DS FS GS
115: ' SI alias RP ' BP alias UP ' DI Alias OP
116: : .386 .asize on .osize on sclear ; .386
117: : .86 .asize off .osize off sclear ;
118: : asize@ 2 .anow @ IF 2* THEN ;
119: : osize@ 2 .onow @ IF 2* THEN ;
120:
121: \ Address modes 01may95py
122: : #) ( disp -- reg )
123: disp ! .anow @ IF 55 4 ELSE 66 2 THEN disp# ! ;
124: : *2 100 xor ; : *4 200 xor ; : *8 300 xor ;
125: : index ( reg1 reg2 -- modr/m ) 370 and swap 7 and or ;
126: : I) ( reg1 reg2 -- ireg ) .anow @ 0= abort" No Index!"
127: *8 index SIB ! 1 SIB# ! 44 ;
128: : I#) ( disp32 reg -- ireg ) BP swap I) swap #) drop ;
129: : seg) ( seg disp -- -1 )
130: disp ! asize@ disp# ! imm ! 2 imm# ! -1 ;
131: : ) ( reg -- reg ) dup SP = IF dup I) ELSE 77 and THEN ;
132: : D) ( disp reg -- reg ) ) >r dup disp ! $80 -$80 within
133: Adisp? @ or IF 200 asize@ ELSE 100 1 THEN disp# ! r> or ;
134: : DI) ( disp reg1 reg2 -- ireg ) I) D) ;
135: : A: ( -- ) Adisp? on ; : A:: ( -- ) -2 Adisp? ! ;
136: : A#) ( imm -- ) A: #) ; : Aseg) ( * -- ) A: seg) ;
137:
138: \ # A# rel) CR DR TR ST <ST STP 01jan98py
139: : # ( imm -- ) dup imm ! -$80 $80 within byte? @ or
140: IF 1 ELSE osize@ THEN imm# ! ;
141: : L# ( imm -- ) imm ! osize@ imm# ! ;
142: : A# ( imm -- ) Aimm? on L# ;
143: : rel) ( addr -- -2 ) disp ! asize@ disp# ! -2 ;
144: : L) ( disp reg -- reg ) ) >r disp ! 200 asize@ disp# ! r> or ;
145: : LI) ( disp reg1 reg2 -- reg ) I) L) ;
146: : >>mod ( reg1 reg2 -- mod ) 70 and swap 307 and or ;
147: : >mod ( reg1 reg2 -- ) >>mod modR/M ! 1 modR/M# ! ;
148: : CR ( n -- ) 7 and 11 * $1C0 or ; 0 CR constant CR0
149: : DR ( n -- ) 7 and 11 * $2C0 or ;
150: : TR ( n -- ) 7 and 11 * $3C0 or ;
151: : ST ( n -- ) 7 and $5C0 or ;
152: : <ST ( n -- ) 7 and $7C0 or ;
153: : STP ( n -- ) 7 and $8C0 or ;
154:
155: \ reg? 10apr93py
156: : reg= ( reg flag mask -- flag ) 2 pick and = ;
157: : reg? ( reg -- reg flag ) $C0 -$40 reg= ;
158: : ?reg ( reg -- reg ) reg? 0= abort" reg expected!" ;
159: : ?mem ( mem -- mem ) dup $C0 < 0= abort" mem expected!" ;
160: : ?ax ( reg -- reg ) dup AX <> abort" ax/al expected!" ;
161: : cr? ( reg -- reg flag ) $100 -$100 reg= ;
162: : dr? ( reg -- reg flag ) $200 -$100 reg= ;
163: : tr? ( reg -- reg flag ) $300 -$100 reg= ;
164: : sr? ( reg -- reg flag ) $400 -$100 reg= ;
165: : st? ( reg -- reg flag ) dup $8 rshift 5 - ;
166: : ?st ( reg -- reg ) st? 0< abort" st expected!" ;
167: : xr? ( reg -- reg flag ) dup $FF > ;
168: : ?xr ( reg -- reg ) xr? 0= abort" xr expected!" ;
169: : rel? ( reg -- reg flag ) dup -2 = ;
170: : seg? ( reg -- reg flag ) dup -1 = ;
171:
172: \ Single Byte instruction 27mar94py
173:
174: : bc: ( opcode -- ) Create c, DOES> c@ , ;
175: : bc.b: ( opcode -- ) Create c, DOES> c@ finishb ;
176: : bc0F: ( opcode -- ) Create c, DOES> c@ finish0F ;
177:
178: : seg: ( opcode -- ) Create c, DOES> c@ seg ! ;
179:
180: $26 seg: ES: $2E seg: CS: $36 seg: SS: $3E seg: DS:
181: $64 seg: FS: $65 seg: GS:
182:
183: Forth
184:
185: \ arithmetics 07nov92py
186:
187: : reg>mod ( reg1 reg2 -- 1 / 3 )
188: reg? IF >mod 3 ELSE swap ?reg >mod 1 THEN ;
189: : ari: ( n -- ) Create c,
190: DOES> ( reg1 reg2 / reg -- ) c@ >r imm# @
191: IF imm# @ byte? @ + 1 > over AX = and
192: IF drop $05 r> 70 and or
193: ELSE r> >mod $81 imm# @ 1 byte? @ + = IF 2 + THEN
1.1 anton 194: THEN
1.4 pazsan 195: ELSE reg>mod r> 70 and or
196: THEN finishb ;
1.1 anton 197:
1.4 pazsan 198: 00 ari: add 11 ari: or 22 ari: adc 33 ari: sbb
199: 44 ari: and 55 ari: sub 66 ari: xor 77 ari: cmp
1.1 anton 200:
1.4 pazsan 201: \ bit shifts strings 07nov92py
1.1 anton 202:
1.4 pazsan 203: : shift: ( n -- ) Create c,
204: DOES> ( r/m -- ) c@ >mod imm# @
205: IF imm @ 1 =
206: IF $D1 0 ELSE $C1 1 THEN imm# !
207: ELSE $D3
208: THEN finishb ;
209:
210: 00 shift: rol 11 shift: ror 22 shift: rcl 33 shift: rcr
211: 44 shift: shl 55 shift: shr 66 shift: sal 77 shift: sar
212:
213: $6D bc.b: ins $6F bc.b: outs
214: $A5 bc.b: movs $A7 bc.b: cmps
215: $AB bc.b: stos $AD bc.b: lods $AF bc.b: scas
216:
217: \ movxr 07feb93py
218:
219: : xr>mod ( reg1 reg2 -- 0 / 2 )
220: xr? IF >mod 2 ELSE swap ?xr >mod 0 THEN ;
221:
222: : movxr ( reg1 reg2 -- )
223: 2dup or sr? nip
224: IF xr>mod $8C
225: ELSE 2dup or $8 rshift 1+ -3 and >r xr>mod 0F, r> $20 or
226: THEN or finish ;
227:
228: \ mov 23jan93py
229:
230: : assign# byte? @ 0= IF osize@ imm# ! ELSE 1 imm# ! THEN ;
231:
232: : ?ofax ( reg ax -- flag ) .anow @ IF 55 ELSE 66 THEN AX d= ;
233: : mov ( r/m reg / reg r/m / reg -- ) 2dup or 0> imm# @ and
234: IF assign# reg?
235: IF 7 and $B8 or byte? @ 3 lshift xor byte? off
236: ELSE 0 >mod $C7 THEN
237: ELSE 2dup or $FF > IF movxr exit THEN
238: 2dup ?ofax
239: IF 2drop $A1 ELSE 2dup swap ?ofax
240: IF 2drop $A3 ELSE reg>mod $88 or THEN
1.1 anton 241: THEN
1.4 pazsan 242: THEN finishb ;
1.1 anton 243:
1.4 pazsan 244: \ not neg mul (imul div idiv 29mar94py
1.1 anton 245:
1.4 pazsan 246: : modf ( r/m reg opcode -- ) -rot >mod finish ;
247: : modfb ( r/m reg opcode -- ) -rot >mod finishb ;
248: : mod0F ( r/m reg opcode -- ) -rot >mod finish0F ;
249: : modf: Create c, DOES> c@ modf ;
250: : not: ( mode -- ) Create c, DOES> ( r/m -- ) c@ $F7 modfb ;
251:
252: 00 not: test# 22 not: NOT 33 not: NEG
253: 44 not: MUL 55 not: (IMUL 66 not: DIV 77 not: IDIV
254:
255: : inc: ( mode -- ) Create c,
256: DOES> ( r/m -- ) c@ >r reg? byte? @ 0= and
257: IF 107 and r> 70 and or finish
258: ELSE r> $FF modfb THEN ;
259: 00 inc: INC 11 inc: DEC
260:
261: \ test shld shrd 07feb93py
262:
263: : test ( reg1 reg2 / reg -- ) imm# @
264: IF assign# AX case?
265: IF $A9 ELSE test# exit THEN
266: ELSE ?reg >mod $85 THEN finishb ;
267:
268: : shd ( r/m reg opcode -- )
269: imm# @ IF 1 imm# ! 1- THEN mod0F ;
270: : shld swap 245 shd ; : shrd swap 255 shd ;
271:
272: : btx: ( r/m reg/# code -- ) Create c,
273: DOES> c@ >r imm# @
274: IF 1 imm# ! r> $BA
275: ELSE swap 203 r> >>mod THEN mod0F ;
276: 44 btx: bt 55 btx: bts 66 btx: btr 77 btx: btc
277:
278: \ push pop 05jun92py
279:
280: : pushs swap FS case? IF $A0 or finish0F exit THEN
281: GS case? IF $A8 or finish0F exit THEN
282: 30 and 6 or or finish ;
283:
284: : push ( reg -- )
285: imm# @ 1 = IF $6A finish exit THEN
286: imm# @ IF $68 finish exit THEN
287: reg? IF 7 and $50 or finish exit THEN
288: sr? IF 0 pushs exit THEN
289: 66 $FF modf ;
290: : pop ( reg -- )
291: reg? IF 7 and $58 or finish exit THEN
292: sr? IF 1 pushs exit THEN
293: 06 $8F modf ;
294:
295: \ Ascii Arithmetics 22may93py
296:
297: $27 bc: DAA $2F bc: DAS $37 bc: AAA $3F bc: AAS
298:
299: : aa: Create c,
300: DOES> ( -- ) c@
301: imm# @ 0= IF &10 imm ! THEN 1 imm# ! finish ;
1.6 pazsan 302: $D4 aa: AAM $D5 aa: AAD $D6 bc: SALC $D7 bc: XLAT
1.4 pazsan 303:
304: $60 bc: PUSHA $61 bc: POPA
305: $90 bc: NOP
306: $98 bc: CBW $99 bc: CWD $9B bc: FWAIT
307: $9C bc: PUSHF $9D bc: POPF $9E bc: SAHF $9F bc: LAHF
308: $C9 bc: LEAVE
309: $CC bc: INT3 $CE bc: INTO $CF bc: IRET
310: ' fwait Alias wait
311:
312: \ one byte opcodes 25dec92py
313:
314: $F0 bc: LOCK $F2 bc: REP $F3 bc: REPE
315: $F4 bc: HLT $F5 bc: CMC
316: $F8 bc: CLC $F9 bc: STC $FA bc: CLI $FB bc: STI
317: $FC bc: CLD $FD bc: STD
318:
319: : ?brange ( offword --- offbyte ) dup $80 -$80 within
320: IF ." branch offset out of 1-byte range" THEN ;
321: : sb: ( opcode -- ) Create c,
322: DOES> ( addr -- ) >r [A] here [F] 2 + - ?brange
323: disp ! 1 disp# ! r> c@ finish ;
324: $E0 sb: LOOPNE $E1 sb: LOOPE $E2 sb: LOOP $E3 sb: JCXZ
325: : (ret ( op -- ) imm# @ IF 2 imm# ! 1- THEN finish ;
326: : ret ( -- ) $C3 (ret ;
327: : retf ( -- ) $CB (ret ;
328:
329: \ call jmp 22dec93py
330:
331: : call ( reg / disp -- ) rel?
332: IF drop $E8 disp @ [A] here [F] 1+ asize@ + - disp ! finish
333: exit THEN 22 $FF modf ;
334: : callf ( reg / seg -- )
335: seg? IF drop $9A finish exit THEN 33 $FF modf ;
336:
337: : jmp ( reg / disp -- )
338: rel? IF drop disp @ [A] here [F] 2 + - dup -$80 $80 within
339: IF disp ! 1 disp# ! $EB
340: ELSE 3 - disp ! $E9 THEN finish exit THEN
341: 44 $FF modf ;
342: : jmpf ( reg / seg -- )
343: seg? IF drop $EA finish exit THEN 55 $FF modf ;
344:
345: : next ['] noop >code-address rel) jmp ;
346:
347: \ jump if 22dec93py
348:
349: : cond: 0 DO i Constant LOOP ;
350:
351: $10 cond: vs vc u< u>= 0= 0<> u<= u> 0< 0>= ps pc < >= <= >
352: $10 cond: o no b nb z nz be nbe s ns pe po l nl le nle
353: : jmpIF ( addr cond -- )
354: swap [A] here [F] 2 + - dup -$80 $80 within
355: IF disp ! $70 1
356: ELSE 0F, 4 - disp ! $80 4 THEN disp# ! or finish ;
357: : jmp: Create c, DOES> c@ jmpIF ;
358: : jmps 0 DO i jmp: LOOP ;
359: $10 jmps jo jno jb jnb jz jnz jbe jnbe js jns jpe jpo jl jnl jle jnle
360:
361: \ xchg 22dec93py
362:
363: : setIF ( r/m cond -- ) 0 swap $90 or mod0F ;
364: : set: ( cond -- ) Create c, DOES> c@ setIF ;
365: : sets: ( n -- ) 0 DO I set: LOOP ;
366: $10 sets: seto setno setb setnb sete setne setna seta sets setns setpe setpo setl setge setle setg
367: : xchg ( r/m reg / reg r/m -- )
368: over AX = IF swap THEN reg? 0= IF swap THEN ?reg
369: byte? @ 0= IF AX case?
370: IF reg? IF 7 and $90 or finish exit THEN AX THEN THEN
371: $87 modfb ;
372:
373: : movx ( r/m reg opcode -- ) 0F, modfb ;
374: : movsx ( r/m reg -- ) $BF movx ;
375: : movzx ( r/m reg -- ) $B7 movx ;
376:
377: \ misc 16nov97py
378:
379: : ENTER ( imm8 -- ) 2 imm# ! $C8 finish [A] , [F] ;
380: : ARPL ( reg r/m -- ) swap $63 modf ;
381: $62 modf: BOUND ( mem reg -- )
382:
383: : mod0F: Create c, DOES> c@ mod0F ;
384: $BC mod0F: BSF ( r/m reg -- ) $BD mod0F: BSR ( r/m reg -- )
385:
386: $06 bc0F: CLTS
387: $08 bc0F: INVD $09 bc0F: WBINVD
388:
389: : CMPXCHG ( reg r/m -- ) swap $A7 movx ;
390: : CMPXCHG8B ( r/m -- ) $8 $C7 movx ;
391: : BSWAP ( reg -- ) 7 and $C8 or finish0F ;
392: : XADD ( r/m reg -- ) $C1 movx ;
393:
394: \ misc 20may93py
395:
396: : IMUL ( r/m reg -- ) imm# @ 0=
397: IF dup AX = IF drop (IMUL exit THEN
398: $AF mod0F exit THEN
399: >mod imm# @ 1 = IF $6B ELSE $69 THEN finish ;
400: : io ( oc -- ) imm# @ IF 1 imm# ! ELSE $8 + THEN finishb ;
401: : IN ( -- ) $E5 io ;
402: : OUT ( -- ) $E7 io ;
403: : INT ( -- ) 1 imm# ! $CD finish ;
404: : 0F.0: ( r/m -- ) Create c, DOES> c@ $00 mod0F ;
405: 00 0F.0: SLDT 11 0F.0: STR 22 0F.0: LLDT 33 0F.0: LTR
406: 44 0F.0: VERR 55 0F.0: VERW
407: : 0F.1: ( r/m -- ) Create c, DOES> c@ $01 mod0F ;
408: 00 0F.1: SGDT 11 0F.1: SIDT 22 0F.1: LGDT 33 0F.1: LIDT
409: 44 0F.1: SMSW 66 0F.1: LMSW 77 0F.1: INVLPG
410:
411: \ misc 29mar94py
412:
413: $02 mod0F: LAR ( r/m reg -- )
414: $8D modf: LEA ( m reg -- )
415: $C4 modf: LES ( m reg -- )
416: $C5 modf: LDS ( m reg -- )
417: $B2 mod0F: LSS ( m reg -- )
418: $B4 mod0F: LFS ( m reg -- )
419: $B5 mod0F: LGS ( m reg -- )
420: \ Pentium/AMD K5 codes
421: : cpuid ( -- ) 0F, $A2 [A] , [F] ;
422: : cmpchx8b ( m -- ) 0 $C7 mod0F ;
423: : rdtsc ( -- ) 0F, $31 [A] , [F] ;
424: : rdmsr ( -- ) 0F, $32 [A] , [F] ;
425: : wrmsr ( -- ) 0F, $30 [A] , [F] ;
426: : rsm ( -- ) 0F, $AA [A] , [F] ;
427:
428: \ Floating point instructions 22dec93py
429:
430: $D8 bc: D8, $D9 bc: D9, $DA bc: DA, $DB bc: DB,
431: $DC bc: DC, $DD bc: DD, $DE bc: DE, $DF bc: DF,
432:
433: : D9: Create c, DOES> D9, c@ finish ;
434:
435: Variable fsize
436: : .fs 0 fsize ! ; : .fl 4 fsize ! ; : .fx 3 fsize ! ;
437: : .fw 6 fsize ! ; : .fd 2 fsize ! ; : .fq 7 fsize ! ;
438: .fx
439: : fop: Create c, DOES> ( fr/m -- ) c@ >r
440: st? dup 0< 0= IF swap r> >mod 2* $D8 + finish exit THEN
441: drop ?mem r> >mod $D8 fsize @ dup 1 and dup 2* + - +
442: finish ;
443: : f@!: Create c, DOES> ( fm -- ) c@ $D9 modf ;
444:
445: \ Floating point instructions 08jun92py
446:
447: $D0 D9: FNOP
448:
449: $E0 D9: FCHS $E1 D9: FABS
450: $E4 D9: FTST $E5 D9: FXAM
451: $E8 D9: FLD1 $E9 D9: FLDL2T $EA D9: FLDL2E $EB D9: FLDPI
452: $EC D9: FLDLG2 $ED D9: FLDLN2 $EE D9: FLDZ
453: $F0 D9: F2XM1 $F1 D9: FYL2X $F2 D9: FPTAN $F3 D9: FPATAN
454: $F4 D9: FXTRACT $F5 D9: FPREM1 $F6 D9: FDECSTP $F7 D9: FINCSTP
455: $F8 D9: FPREM $F9 D9: FYL2XP1 $FA D9: FSQRT $FB D9: FSINCOS
456: $FC D9: FRNDINT $FD D9: FSCALE $FE D9: FSIN $FF D9: FCOS
457:
458: \ Floating point instructions 23jan94py
459:
460: 00 fop: FADD 11 fop: FMUL 22 fop: FCOM 33 fop: FCOMP
461: 44 fop: FSUB 55 fop: FSUBR 66 fop: FDIV 77 fop: FDIVR
462:
463: : FCOMPP ( -- ) [A] 1 stp fcomp [F] ;
464: : FBLD ( fm -- ) 44 $D8 modf ;
465: : FBSTP ( fm -- ) 66 $DF modf ;
466: : FFREE ( st -- ) 00 $DD modf ;
467: : FSAVE ( fm -- ) 66 $DD modf ;
468: : FRSTOR ( fm -- ) 44 $DD modf ;
469: : FINIT ( -- ) [A] DB, $E3 , [F] ;
470: : FXCH ( st -- ) 11 $D9 modf ;
471:
472: 44 f@!: FLDENV 55 f@!: FLDCW 66 f@!: FSTENV 77 f@!: FSTCW
473:
474: \ fild fst fstsw fucom 22may93py
475: : FUCOM ( st -- ) ?st st? IF 77 ELSE 66 THEN $DD modf ;
476: : FUCOMPP ( -- ) [A] DA, $E9 , [F] ;
477: : FNCLEX ( -- ) [A] DB, $E2 , [F] ;
478: : FCLEX ( -- ) [A] fwait fnclex [F] ;
479: : FSTSW ( r/m -- )
480: dup AX = IF 44 ELSE ?mem 77 THEN $DF modf ;
481: : f@!, fsize @ 1 and IF drop ELSE nip THEN
482: fsize @ $D9 or modf ;
483: : fx@!, ( mem/st l x -- ) rot st? 0=
484: IF swap $DD modf drop exit THEN ?mem -rot
485: fsize @ 3 = IF drop $DB modf exit THEN f@!, ;
486: : FST ( st/m -- ) st? 0=
487: IF 22 $DD modf exit THEN ?mem 77 22 f@!, ;
488: : FLD ( st/m -- ) st? 0= IF 0 $D9 modf exit THEN 55 0 fx@!, ;
489: : FSTP ( st/m -- ) 77 33 fx@!, ;
490:
491: \ PPro instructions 28feb97py
492:
493:
494: : cmovIF ( r/m r flag -- ) $40 or mod0F ;
495: : cmov: Create c, DOES> c@ cmovIF ;
496: : cmovs: 0 DO I cmov: LOOP ;
497: $10 cmovs: cmovo cmovno cmovb cmovnb cmovz cmovnz cmovbe cmovnbe cmovs cmovns cmovpe cmovpo cmovl cmovnl cmovle cmovnle
498:
499: \ MMX opcodes 02mar97py
500:
501: 300 7 regs MM0 MM1 MM2 MM3 MM4 MM5 MM6 MM7
502:
503: : mmxs ?DO I mod0F: LOOP ;
504: $64 $60 mmxs PUNPCKLBW PUNPCKLWD PUNOCKLDQ PACKUSDW
505: $68 $64 mmxs PCMPGTB PCMPGTW PCMPGTD PACKSSWB
506: $6C $68 mmxs PUNPCKHBW PUNPCKHWD PUNPCKHDQ PACKSSDW
507: $78 $74 mmxs PCMPEQB PCMPEQW PCMPEQD EMMS
508: $DA $D8 mmxs PSUBUSB PSUBUSW
509: $EA $E8 mmxs PSUBSB PSUBSW
510: $FB $F8 mmxs PSUBB PSUBW PSUBD
511: $DE $DC mmxs PADDUSB PADDUSW
512: $EE $EC mmxs PADDSB PADDSW
513: $FF $FC mmxs PADDB PADDW PADDD
514:
515: \ MMX opcodes 02mar97py
516:
517: $D5 mod0F: pmullw $E5 mod0F: pmulhw
518: $F5 mod0F: pmaddwd
519: $DB mod0F: pand $DF mod0F: pandn
520: $EB mod0F: por $EF mod0F: pxor
521: : pshift ( mmx imm/m mod op -- )
522: imm# @ IF 1 imm# ! ELSE + $50 + THEN mod0F ;
523: : PSRLW ( mmx imm/m -- ) 020 $71 pshift ;
524: : PSRLD ( mmx imm/m -- ) 020 $72 pshift ;
525: : PSRLQ ( mmx imm/m -- ) 020 $73 pshift ;
526: : PSRAW ( mmx imm/m -- ) 040 $71 pshift ;
527: : PSRAD ( mmx imm/m -- ) 040 $72 pshift ;
528: : PSLLW ( mmx imm/m -- ) 060 $71 pshift ;
529: : PSLLD ( mmx imm/m -- ) 060 $72 pshift ;
530: : PSLLQ ( mmx imm/m -- ) 060 $73 pshift ;
531:
532: \ MMX opcodes 27jun99beu
533:
534: \ mmxreg --> mmxreg move
535: $6F mod0F: MOVQ
536:
537: \ memory/reg32 --> mmxreg load
538: $6F mod0F: PLDQ \ Intel: MOVQ mm,m64
539: $6E mod0F: PLDD \ Intel: MOVD mm,m32/r
540:
541: \ mmxreg --> memory/reg32
542: : PSTQ ( mm m64 -- ) SWAP $7F mod0F ; \ Intel: MOVQ m64,mm
543: : PSTD ( mm m32/r -- ) SWAP $7E mod0F ; \ Intel: MOVD m32/r,mm
544:
545: \ 3Dnow! opcodes (K6) 21apr00py
546: : mod0F# ( code imm -- ) # 1 imm ! mod0F ;
547: : 3Dnow: ( imm -- ) Create c, DOES> c@ mod0F# ;
548: $0D 3Dnow: PI2FD $1D 3Dnow: PF2ID
549: $90 3Dnow: PFCMPGE $A0 3Dnow: PFCMPGT
550: $94 3Dnow: PFMIN $A4 3Dnow: PFMAX
551: $96 3Dnow: PFRCP $A6 3Dnow: PFRCPIT1
552: $97 3Dnow: PFRSQRT $A7 3Dnow: PFRSQIT1
553: $9A 3Dnow: PFSUB $AA 3Dnow: PFSUBR
554: $9E 3Dnow: PFADD $AE 3Dnow: PFACC
555: $B0 3Dnow: PFCMPEQ $B4 3Dnow: PFMUL
556: $B6 3Dnow: PFRCPIT2 $B7 3Dnow: PMULHRW
557: $BF 3Dnow: PAVGUSB
558:
559: : FEMMS $0E finish0F ;
560: : PREFETCH 000 $0D mod0F ; : PREFETCHW 010 $0D mod0F ;
561:
562: \ 3Dnow!+MMX opcodes (Athlon) 21apr00py
563:
564: $F7 mod0F: MASKMOVQ $E7 mod0F: MOVNTQ
565: $E0 mod0F: PAVGB $E3 mod0F: PAVGW
566: $C5 mod0F: PEXTRW $C4 mod0F: PINSRW
567: $EE mod0F: PMAXSW $DE mod0F: PMAXUB
568: $EA mod0F: PMINSW $DA mod0F: PMINUB
569: $D7 mod0F: PMOVMSKB $E4 mod0F: PMULHUW
570: $F6 mod0F: PSADBW $70 mod0F: PSHUFW
571:
572: $0C 3Dnow: PI2FW $1C 3Dnow: PF2IW
573: $8A 3Dnow: PFNACC $8E 3Dnow: PFPNACC
574: $BB 3Dnow: PSWABD : SFENCE $AE $07 mod0F# ;
575: : PREFETCHNTA 000 $18 mod0F ; : PREFETCHT0 010 $18 mod0F ;
576: : PREFETCHT1 020 $18 mod0F ; : PREFETCHT2 030 $18 mod0F ;
577:
578: \ Assembler Conditionals 22dec93py
579: : ~cond ( cond -- ~cond ) 1 xor ;
580: : >offset ( start dest --- offbyte ) swap 2 + - ?brange ;
581: : IF ( cond -- here ) [A] here [F] dup 2 + rot ~cond jmpIF ;
582: : THEN dup [A] here >offset swap 1+ c! [F] ;
583: : AHEAD [A] here [F] dup 2 + rel) jmp ;
584: : ELSE [A] AHEAD swap THEN [F] ;
585: : BEGIN [A] here ; ' BEGIN Alias DO [F]
586: : WHILE [A] IF [F] swap ;
587: : UNTIL ~cond jmpIF ;
588: : AGAIN rel) jmp ;
589: : REPEAT [A] AGAIN THEN [F] ;
590: : ?DO [A] here [F] dup 2 + dup jcxz ;
591: : BUT swap ;
592: : YET dup ;
593: : makeflag [A] ~cond AL swap setIF 1 # AX and AX dec [F] ;
1.1 anton 594:
595:
1.8 pazsan 596: previous previous set-current decimal base !
1.1 anton 597:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>