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