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

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

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