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>