basis/cpu/x86/assembler/operands/operands.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel words math accessors sequences namespaces
   4 assocs layouts cpu.x86.assembler.syntax ;
   5 IN: cpu.x86.assembler.operands
   6
   7 REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ;
   8
   9 HI-REGISTERS: 8 AH CH DH BH ;
  10
  11 REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ;
  12
  13 REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ;
  14
  15 REGISTERS: 64 RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
  16
  17 REGISTERS: 128
  18 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
  19 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
  20
  21 REGISTERS: 80 ST0 ST1 ST2 ST3 ST4 ST5 ST6 ST7 ;
  22
  23 : shuffle-down ( STn -- STn+1 )
  24     "register" word-prop 1 + 80 registers get at nth ;
  25
  26 PREDICATE: register < word
  27     "register" word-prop ;
  28
  29 <PRIVATE
  30
  31 PREDICATE: register-8 < register
  32     "register-size" word-prop 8 = ;
  33
  34 PREDICATE: register-16 < register
  35     "register-size" word-prop 16 = ;
  36
  37 PREDICATE: register-32 < register
  38     "register-size" word-prop 32 = ;
  39
  40 PREDICATE: register-64 < register
  41     "register-size" word-prop 64 = ;
  42
  43 PREDICATE: register-128 < register
  44     "register-size" word-prop 128 = ;
  45
  46 GENERIC: extended? ( op -- ? )
  47
  48 M: object extended? drop f ;
  49
  50 M: register extended? "register" word-prop 7 > ;
  51
  52 ! Addressing modes
  53 TUPLE: indirect base index scale displacement ;
  54
  55 M: indirect extended? base>> extended? ;
  56
  57 : canonicalize-displacement ( indirect -- indirect )
  58     dup [ base>> ] [ displacement>> 0 = ] bi and
  59     [ f >>displacement ] when ;
  60
  61 : canonicalize-EBP ( indirect -- indirect )
  62     ! { EBP } ==> { EBP 0 }
  63     dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
  64     [ 0 >>displacement ] when ;
  65
  66 ERROR: bad-index indirect ;
  67
  68 : check-ESP ( indirect -- indirect )
  69     dup index>> { ESP RSP } member-eq? [ bad-index ] when ;
  70
  71 : canonicalize ( indirect -- indirect )
  72     ! Modify the indirect to work around certain addressing mode
  73     ! quirks.
  74     canonicalize-displacement canonicalize-EBP check-ESP ;
  75
  76 ! Utilities
  77 UNION: operand register indirect ;
  78
  79 GENERIC: operand-64? ( operand -- ? )
  80
  81 M: indirect operand-64?
  82     [ base>> ] [ index>> ] bi [ operand-64? ] either? ;
  83
  84 M: register-64 operand-64? drop t ;
  85
  86 M: object operand-64? drop f ;
  87
  88 PRIVATE>
  89
  90 : <indirect> ( base index scale displacement -- indirect )
  91     indirect boa canonicalize ;
  92
  93 : [] ( base/displacement -- indirect )
  94     dup integer?
  95     [ [ f f bootstrap-cell 8 = 0 f ? ] dip <indirect> ]
  96     [ f f f <indirect> ]
  97     if ;
  98
  99 : [RIP+] ( displacement -- indirect )
 100     [ f f f ] dip <indirect> ;
 101
 102 : [+] ( base index/displacement -- indirect )
 103     dup integer?
 104     [ [ f f ] dip ]
 105     [ f f ] if
 106     <indirect> ;
 107
 108 : [++] ( base index displacement -- indirect )
 109     [ f ] dip <indirect> ;
 110
 111 : [+*2+] ( base index displacement -- indirect )
 112     [ 1 ] dip <indirect> ;
 113
 114 : [+*4+] ( base index displacement -- indirect )
 115     [ 2 ] dip <indirect> ;
 116
 117 : [+*8+] ( base index displacement -- indirect )
 118     [ 3 ] dip <indirect> ;
 119
 120 TUPLE: byte value ;
 121
 122 C: <byte> byte
 123
 124 : extended-8-bit-register? ( register -- ? )
 125     { SPL BPL SIL DIL } member-eq? ;
 126
 127 : n-bit-version-of ( register n -- register' )
 128     ! Certain 8-bit registers don't exist in 32-bit mode...
 129     [ "register" word-prop ] dip registers get at nth
 130     dup extended-8-bit-register? cell 4 = and
 131     [ drop f ] when ;
 132
 133 : 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ;
 134 : 16-bit-version-of ( register -- register' ) 16 n-bit-version-of ;
 135 : 32-bit-version-of ( register -- register' ) 32 n-bit-version-of ;
 136 : 64-bit-version-of ( register -- register' ) 64 n-bit-version-of ;
 137 : native-version-of ( register -- register' ) cell-bits n-bit-version-of ;