Annotation of gforth/arch/386/asm.fs, revision 1.10

1.4       pazsan      1: \         *** Assembler for the Intel i486 ***         07nov92py
1.5       pazsan      2: 
                      3: \ Copyright (C) 1992-2000 by Bernd Paysan
                      4: 
1.10    ! anton       5: \ Copyright (C) 2000,2001 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>