File:  [gforth] / gforth / arch / 386 / asm.fs
Revision 1.10: download - view: text, annotated - select for diffs
Sun Mar 9 15:16:57 2003 UTC (21 years, 1 month ago) by anton
Branches: MAIN
CVS tags: v0-6-1, v0-6-0, HEAD
updated copyright years

    1: \         *** Assembler for the Intel i486 ***         07nov92py
    2: 
    3: \ Copyright (C) 1992-2000 by Bernd Paysan
    4: 
    5: \ Copyright (C) 2000,2001 Free Software Foundation, Inc.
    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
   21: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   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      ;
   57: Create nrc  ' c, A, ' here A, ' allot A, ' c! A, ' (+rel A,
   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
  195:           THEN
  196:     ELSE  reg>mod  r> 70 and or
  197:     THEN  finishb  ;
  198: 
  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
  201: 
  202: \ bit shifts    strings                                07nov92py
  203: 
  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
  242:         THEN
  243:   THEN  finishb ;
  244: 
  245: \ not neg mul (imul div idiv                           29mar94py
  246: 
  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 ;
  303: $D4 aa: AAM     $D5 aa: AAD     $D6 bc: SALC    $D7 bc: XLAT
  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] ;
  595: 
  596: 
  597: previous previous set-current decimal base !
  598: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>