gsc/_x86#.scm

   1 ;;;============================================================================
   2
   3 ;;; File: "_x86#.scm"
   4
   5 ;;; Copyright (c) 2010-2012 by Marc Feeley, All Rights Reserved.
   6
   7 ;;;============================================================================
   8
   9 (namespace ("_x86#"
  10
  11 x86-implement
  12
  13 x86-register-name
  14 x86-reg?
  15 x86-reg8?
  16 x86-reg8-h?
  17 x86-xmm?
  18 x86-mm?
  19 x86-fpu?
  20 x86-reg16?
  21 x86-reg32?
  22 x86-reg64?
  23 x86-reg-field
  24 x86-reg8
  25 x86-reg16
  26 x86-reg32
  27 x86-reg64
  28 x86-fpu
  29 x86-reg-width
  30
  31 x86-al
  32 x86-cl
  33 x86-dl
  34 x86-bl
  35 x86-ah
  36 x86-ch
  37 x86-dh
  38 x86-bh
  39 x86-spl
  40 x86-bpl
  41 x86-sil
  42 x86-dil
  43 x86-r8b
  44 x86-r9b
  45 x86-r10b
  46 x86-r11b
  47 x86-r12b
  48 x86-r13b
  49 x86-r14b
  50 x86-r15b
  51
  52 x86-ax
  53 x86-cx
  54 x86-dx
  55 x86-bx
  56 x86-sp
  57 x86-bp
  58 x86-si
  59 x86-di
  60 x86-r8w
  61 x86-r9w
  62 x86-r10w
  63 x86-r11w
  64 x86-r12w
  65 x86-r13w
  66 x86-r14w
  67 x86-r15w
  68
  69 x86-eax
  70 x86-ecx
  71 x86-edx
  72 x86-ebx
  73 x86-esp
  74 x86-ebp
  75 x86-esi
  76 x86-edi
  77 x86-r8d
  78 x86-r9d
  79 x86-r10d
  80 x86-r11d
  81 x86-r12d
  82 x86-r13d
  83 x86-r14d
  84 x86-r15d
  85
  86 x86-rax
  87 x86-rcx
  88 x86-rdx
  89 x86-rbx
  90 x86-rsp
  91 x86-rbp
  92 x86-rsi
  93 x86-rdi
  94 x86-r8
  95 x86-r9
  96 x86-r10
  97 x86-r11
  98 x86-r12
  99 x86-r13
 100 x86-r14
 101 x86-r15
 102
 103 x86-st
 104 x86-st1
 105 x86-st2
 106 x86-st3
 107 x86-st4
 108 x86-st5
 109 x86-st6
 110 x86-st7
 111
 112 x86-mm0
 113 x86-mm1
 114 x86-mm2
 115 x86-mm3
 116 x86-mm4
 117 x86-mm5
 118 x86-mm6
 119 x86-mm7
 120
 121 x86-xmm0
 122 x86-xmm1
 123 x86-xmm2
 124 x86-xmm3
 125 x86-xmm4
 126 x86-xmm5
 127 x86-xmm6
 128 x86-xmm7
 129 x86-xmm8
 130 x86-xmm9
 131 x86-xmm10
 132 x86-xmm11
 133 x86-xmm12
 134 x86-xmm13
 135 x86-xmm14
 136 x86-xmm15
 137
 138 x86-es
 139 x86-cs
 140 x86-ss
 141 x86-ds
 142 x86-fs
 143 x86-gs
 144
 145 x86-arch-set!
 146 x86-64bit-mode?
 147 x86-word-width
 148
 149 x86-imm-int
 150 x86-imm-int?
 151 x86-imm-int-value
 152 x86-imm-lbl
 153 x86-mem
 154
 155 x86-label
 156 x86-db
 157 x86-dw
 158 x86-dd
 159 x86-dq
 160
 161 x86-add
 162 x86-or
 163 x86-adc
 164 x86-sbb
 165 x86-and
 166 x86-sub
 167 x86-xor
 168 x86-cmp
 169 x86-mov
 170
 171 x86-inc
 172 x86-dec
 173
 174 x86-lea
 175
 176 x86-ret
 177
 178 x86-enter
 179
 180 x86-nop
 181 x86-leave
 182 x86-hlt
 183 x86-cmc
 184 x86-clc
 185 x86-stc
 186 x86-cli
 187 x86-sti
 188 x86-cld
 189 x86-std
 190
 191 x86-syscall
 192 x86-sysret
 193 x86-wrmsr
 194 x86-rdtsc
 195 x86-rdmsr
 196 x86-rdpmc
 197 x86-cpuid
 198
 199 x86-jmp
 200 x86-call
 201 x86-jo
 202 x86-jno
 203 x86-jb
 204 x86-jae
 205 x86-je
 206 x86-jne
 207 x86-jbe
 208 x86-ja
 209 x86-js
 210 x86-jns
 211 x86-jp
 212 x86-jnp
 213 x86-jl
 214 x86-jge
 215 x86-jle
 216 x86-jg
 217
 218 x86-push
 219 x86-pop
 220
 221 x86-cwde
 222 x86-cdq
 223 x86-cbw
 224 x86-cwd
 225 x86-cdqe
 226 x86-cqo
 227
 228 x86-rol
 229 x86-ror
 230 x86-rcl
 231 x86-rcr
 232 x86-shl
 233 x86-shr
 234 x86-sar
 235
 236 x86-neg
 237 x86-not
 238
 239 x86-test
 240
 241 x86-xchg
 242
 243 x86-mul
 244 x86-imul
 245 x86-div
 246 x86-idiv
 247
 248 x86-movzx
 249 x86-movsx
 250
 251 x86-bt
 252 x86-bts
 253 x86-btr
 254 x86-btc
 255
 256 ))
 257
 258 ;;;============================================================================
 259
 260 ;; Define x86 register classes.
 261
 262 (define-macro (x86-define-registers . definitions)
 263
 264   (define names (make-vector (+ 96 8) "invalidreg"))
 265
 266   (define (get d attrib)
 267     (let ((x (member attrib (cdr d))))
 268       (if x (cadr x) #f)))
 269
 270   (define (gen-def d)
 271     (let ((id (car d)))
 272       (let ((class (get d 'class:))
 273             (field (get d 'field:))
 274             (mode  (get d 'mode:))
 275             (name  (or (get d 'name:) id)))
 276         (if (member class '(r8 r16 r32 r64 fpu mm xmm))
 277             (let ((i (+ field
 278                         (if (and (eq? class 'r8)
 279                                  (>= field 4)
 280                                  (< field 8)
 281                                  (not (eq? mode 'long)))
 282                             16
 283                             0)
 284                         (case class
 285                           ((r64) 0)
 286                           ((r32) 16)
 287                           ((r16) 32)
 288                           ((fpu) 48)
 289                           ((mm)  56)
 290                           ((xmm) 64)
 291                           ((r8)  80)))))
 292               (vector-set! names i name)
 293               `((define-macro (,(string->symbol (string-append "x86-" (symbol->string id))))
 294                   ,i)))
 295             `()))))
 296
 297   (let* ((defs
 298            (apply append (map gen-def definitions)))
 299          (code
 300           `(begin
 301              (define-macro (x86-implement)
 302                `(begin
 303                   (define (x86-register-name reg)
 304                     (vector-ref ',',names reg))))
 305              (define-macro (x86-reg? x)
 306                `(fixnum? ,x))
 307              (define-macro (x86-reg8? reg)
 308                `(let ((n ,reg)) (fx>= n 80)))
 309              (define-macro (x86-reg8-h? reg)
 310                `(let ((n ,reg)) (fx>= n 96)))
 311              (define-macro (x86-xmm? reg)
 312                `(let ((n ,reg)) (and (fx>= n 64) (fx< n 80))))
 313              (define-macro (x86-mm? reg)
 314                `(let ((n ,reg)) (and (fx>= n 56) (fx< n 64))))
 315              (define-macro (x86-fpu? reg)
 316                `(let ((n ,reg)) (and (fx>= n 48) (fx< n 56))))
 317              (define-macro (x86-reg16? reg)
 318                `(let ((n ,reg)) (and (fx>= n 32) (fx< n 48))))
 319              (define-macro (x86-reg32? reg)
 320                `(let ((n ,reg)) (and (fx>= n 16) (fx< n 32))))
 321              (define-macro (x86-reg64? reg)
 322                `(let ((n ,reg)) (fx< n 16)))
 323              (define-macro (x86-reg-field reg)
 324                `(fxand ,reg 15))
 325              (define-macro (x86-reg8 n)
 326                `(fx+ 80 ,n))
 327              (define-macro (x86-reg16 n)
 328                `(fx+ 32 ,n))
 329              (define-macro (x86-reg32 n)
 330                `(fx+ 16 ,n))
 331              (define-macro (x86-reg64 n)
 332                n)
 333              (define-macro (x86-fpu n)
 334                `(fx+ 48 ,n))
 335              (define-macro (x86-reg-width reg)
 336                `(let ((n ,reg))
 337                   (cond ((fx< n 16) 64)
 338                         ((fx< n 32) 32)
 339                         ((fx< n 48) 16)
 340                         ((fx< n 64) 80)
 341                         ((fx< n 80) 128)
 342                         (else       8))))
 343              ,@defs)))
 344     ;;(pp code)
 345     ;;(pp names)
 346     code))
 347
 348 (x86-define-registers
 349
 350   (al      class: r8  field: 0 )
 351   (cl      class: r8  field: 1 )
 352   (dl      class: r8  field: 2 )
 353   (bl      class: r8  field: 3 )
 354   (ah      class: r8  field: 4 )
 355   (ch      class: r8  field: 5 )
 356   (dh      class: r8  field: 6 )
 357   (bh      class: r8  field: 7 )
 358   (spl     class: r8  field: 4  mode: long)
 359   (bpl     class: r8  field: 5  mode: long)
 360   (sil     class: r8  field: 6  mode: long)
 361   (dil     class: r8  field: 7  mode: long)
 362   (r8b     class: r8  field: 8  mode: long)
 363   (r9b     class: r8  field: 9  mode: long)
 364   (r10b    class: r8  field: 10 mode: long)
 365   (r11b    class: r8  field: 11 mode: long)
 366   (r12b    class: r8  field: 12 mode: long)
 367   (r13b    class: r8  field: 13 mode: long)
 368   (r14b    class: r8  field: 14 mode: long)
 369   (r15b    class: r8  field: 15 mode: long)
 370
 371   (ax      class: r16 field: 0 )
 372   (cx      class: r16 field: 1 )
 373   (dx      class: r16 field: 2 )
 374   (bx      class: r16 field: 3 )
 375   (sp      class: r16 field: 4 )
 376   (bp      class: r16 field: 5 )
 377   (si      class: r16 field: 6 )
 378   (di      class: r16 field: 7 )
 379   (r8w     class: r16 field: 8  mode: long)
 380   (r9w     class: r16 field: 9  mode: long)
 381   (r10w    class: r16 field: 10 mode: long)
 382   (r11w    class: r16 field: 11 mode: long)
 383   (r12w    class: r16 field: 12 mode: long)
 384   (r13w    class: r16 field: 13 mode: long)
 385   (r14w    class: r16 field: 14 mode: long)
 386   (r15w    class: r16 field: 15 mode: long)
 387
 388   (eax     class: r32 field: 0 )
 389   (ecx     class: r32 field: 1 )
 390   (edx     class: r32 field: 2 )
 391   (ebx     class: r32 field: 3 )
 392   (esp     class: r32 field: 4 )
 393   (ebp     class: r32 field: 5 )
 394   (esi     class: r32 field: 6 )
 395   (edi     class: r32 field: 7 )
 396   (r8d     class: r32 field: 8  mode: long)
 397   (r9d     class: r32 field: 9  mode: long)
 398   (r10d    class: r32 field: 10 mode: long)
 399   (r11d    class: r32 field: 11 mode: long)
 400   (r12d    class: r32 field: 12 mode: long)
 401   (r13d    class: r32 field: 13 mode: long)
 402   (r14d    class: r32 field: 14 mode: long)
 403   (r15d    class: r32 field: 15 mode: long)
 404
 405   (rax     class: r64 field: 0 )
 406   (rcx     class: r64 field: 1 )
 407   (rdx     class: r64 field: 2 )
 408   (rbx     class: r64 field: 3 )
 409   (rsp     class: r64 field: 4 )
 410   (rbp     class: r64 field: 5 )
 411   (rsi     class: r64 field: 6 )
 412   (rdi     class: r64 field: 7 )
 413   (r8      class: r64 field: 8  mode: long)
 414   (r9      class: r64 field: 9  mode: long)
 415   (r10     class: r64 field: 10 mode: long)
 416   (r11     class: r64 field: 11 mode: long)
 417   (r12     class: r64 field: 12 mode: long)
 418   (r13     class: r64 field: 13 mode: long)
 419   (r14     class: r64 field: 14 mode: long)
 420   (r15     class: r64 field: 15 mode: long)
 421
 422   (st      class: fpu field: 0 )
 423   (st1     class: fpu field: 1 name: |st(1)|)
 424   (st2     class: fpu field: 2 name: |st(2)|)
 425   (st3     class: fpu field: 3 name: |st(3)|)
 426   (st4     class: fpu field: 4 name: |st(4)|)
 427   (st5     class: fpu field: 5 name: |st(5)|)
 428   (st6     class: fpu field: 6 name: |st(6)|)
 429   (st7     class: fpu field: 7 name: |st(7)|)
 430
 431   (mm0     class: mm  field: 0 )
 432   (mm1     class: mm  field: 1 )
 433   (mm2     class: mm  field: 2 )
 434   (mm3     class: mm  field: 3 )
 435   (mm4     class: mm  field: 4 )
 436   (mm5     class: mm  field: 5 )
 437   (mm6     class: mm  field: 6 )
 438   (mm7     class: mm  field: 7 )
 439
 440   (xmm0    class: xmm field: 0 )
 441   (xmm1    class: xmm field: 1 )
 442   (xmm2    class: xmm field: 2 )
 443   (xmm3    class: xmm field: 3 )
 444   (xmm4    class: xmm field: 4 )
 445   (xmm5    class: xmm field: 5 )
 446   (xmm6    class: xmm field: 6 )
 447   (xmm7    class: xmm field: 7 )
 448   (xmm8    class: xmm field: 8  mode: long)
 449   (xmm9    class: xmm field: 9  mode: long)
 450   (xmm10   class: xmm field: 10 mode: long)
 451   (xmm11   class: xmm field: 11 mode: long)
 452   (xmm12   class: xmm field: 12 mode: long)
 453   (xmm13   class: xmm field: 13 mode: long)
 454   (xmm14   class: xmm field: 14 mode: long)
 455   (xmm15   class: xmm field: 15 mode: long)
 456
 457   (es      class: seg field: 0 )
 458   (cs      class: seg field: 1 )
 459   (ss      class: seg field: 2 )
 460   (ds      class: seg field: 3 )
 461   (fs      class: seg field: 4 )
 462   (gs      class: seg field: 5 )
 463
 464 )
 465
 466 ;;;============================================================================