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