x86-rreil-translator.ml 69.4 KB
Newer Older
mb0's avatar
Up.  
mb0 committed
1
2
# vim:filetype=sml:ts=3:sw=3:expandtab

Julian Kranz's avatar
Julian Kranz committed
3
export = translate translateBlock
mb0's avatar
Up.  
mb0 committed
4

Julian Kranz's avatar
Julian Kranz committed
5
#Todo: fix
Julian Kranz's avatar
Julian Kranz committed
6
val runtime-stack-address-size = do
Julian Kranz's avatar
Julian Kranz committed
7
8
9
10
11
  mode64 <- mode64?;
  if mode64 then
    return 64
  else
    return 32
Julian Kranz's avatar
Julian Kranz committed
12
13
end

Julian Kranz's avatar
Julian Kranz committed
14
15
16
17
val ip-get = do
  return (imm 0)
end

Julian Kranz's avatar
Julian Kranz committed
18
19
20
21
22
23
24
25
26
27
val segment-register? x =
  case x of
     CS: '1'
   | SS: '1'
   | DS: '1'
   | ES: '1'
   | FS: '1'
   | GS: '1'
  end

Julian Kranz's avatar
Julian Kranz committed
28
val sizeof2 dst/src1 src2 =
mb0's avatar
Up.  
mb0 committed
29
30
31
32
33
34
35
36
37
38
   case dst/src1 of
      REG r: return ($size (semantic-register-of r))
    | MEM x: return x.sz
    | _:
         case src2 of
            REG r: return ($size (semantic-register-of r))
          | MEM x: return x.sz
         end
   end

Julian Kranz's avatar
Julian Kranz committed
39
40
41
42
43
44
45
46
47
val sizeof-flow target =
  case target of
     REL8 x: return 8
   | REL16 x: return 16
   | REL32 x: return 32
   | REL64 x: return 64
   | NEARABS x: sizeof1 x
   | FARABS x: sizeof1 x
  end
mb0's avatar
Up.  
mb0 committed
48

Julian Kranz's avatar
Julian Kranz committed
49
val sizeof1 op =
mb0's avatar
Up.  
mb0 committed
50
51
52
53
54
55
56
57
58
   case op of
      REG r: return (semantic-register-of r).size
    | MEM x: return x.sz
    | IMM8 i: return 8
    | IMM16 i: return 16
    | IMM32 i: return 32
    | IMM64 i: return 64
   end

Julian Kranz's avatar
Julian Kranz committed
59
60
61
62
type signedness =
   Signed
 | Unsigned

Julian Kranz's avatar
Julian Kranz committed
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
val expand conv lin from-sz to-sz = do
  if from-sz === to-sz then
    return lin
  else
    do
      expanded <- mktemp;
      case conv of
         Signed: movsx to-sz expanded from-sz lin
       | Unsigned: movzx to-sz expanded from-sz lin
      end;
      return (var expanded)
    end
end

val segment-add mode64 address segment = let
  val seg-sem seg-reg = SEM_LIN_VAR(semantic-register-of seg-reg)
Julian Kranz's avatar
Julian Kranz committed
79
in
Julian Kranz's avatar
Julian Kranz committed
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
  case segment of
     SEG_NONE:
       if mode64 then
         address
       else
         SEM_LIN_ADD {opnd1=seg-sem DS,opnd2=address}
   | SEG_OVERRIDE s:
       if mode64 then
         case s of
            FS: SEM_LIN_ADD {opnd1=seg-sem s,opnd2=address}
  	  | GS: SEM_LIN_ADD {opnd1=seg-sem s,opnd2=address}
	  | _: address
	 end
       else
         SEM_LIN_ADD {opnd1=seg-sem s,opnd2=address}
  end
Julian Kranz's avatar
Julian Kranz committed
96
end
Julian Kranz's avatar
Julian Kranz committed
97

Julian Kranz's avatar
Julian Kranz committed
98
99
100
101
102
#IA-32e => 64 bit real addresses
val real-addr-sz = return 64

val segmented-lin lin sz segment = do
  real-addr-sz <- real-addr-sz;
Julian Kranz's avatar
Julian Kranz committed
103
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
104

Julian Kranz's avatar
Julian Kranz committed
105
  expanded <- expand Unsigned lin sz real-addr-sz;
Julian Kranz's avatar
Julian Kranz committed
106
107
  return (segment-add mode64 expanded segment)
end
Julian Kranz's avatar
Julian Kranz committed
108
val segmented-reg reg segment = segmented-lin (var reg) reg.size segment
Julian Kranz's avatar
Julian Kranz committed
109
110
111
112
113
114
115
116
117
118
119
120
121

val segmented-load dst-sz dst addr-sz address segment = do
  address-segmented <- segmented-lin address addr-sz segment;
  addr-sz <- real-addr-sz;
  load dst-sz dst addr-sz address-segmented
end

val segmented-store addr rhs segment = do
  address-segmented <- segmented-lin addr.address addr.size segment;
  addr-sz <- real-addr-sz;
  store (address addr-sz address-segmented) rhs
end

Julian Kranz's avatar
Julian Kranz committed
122
#val segment segment = do
Julian Kranz's avatar
Julian Kranz committed
123
124
125
126
127
128
129
130
131
132
133
134
#  mode64 <- mode64?;
#  if mode64 then
#    case segment of
#       SEG_NONE: return 
#
#    case segment of
#       FS: return segment
#     | GS: return segment
#     | _: return DS
#    end
#  else
#    return segment
Julian Kranz's avatar
Julian Kranz committed
135
136
#  return DS
#end
Julian Kranz's avatar
Julian Kranz committed
137

Julian Kranz's avatar
Julian Kranz committed
138
val conv-with conv sz x =
mb0's avatar
Up.  
mb0 committed
139
   let
Julian Kranz's avatar
Julian Kranz committed
140
141
142
143
144
      val conv-imm conv x = case conv of
      	  Signed: return (SEM_LIN_IMM{imm=sx x})
	| Unsigned: return (SEM_LIN_IMM{imm=zx x})
      end

Julian Kranz's avatar
Julian Kranz committed
145
146
147
148
      val conv-reg conv sz r = do
        reg <- return (semantic-register-of r);
	expand conv (var reg) reg.size sz
      end
mb0's avatar
Up.  
mb0 committed
149

Julian Kranz's avatar
Julian Kranz committed
150
      val conv-sum conv sz x =
mb0's avatar
Up.  
mb0 committed
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
         do op1 <- conv-with conv sz x.a;
            op2 <- conv-with conv sz x.b;
            return
               (SEM_LIN_ADD
                  {opnd1=op1,
                   opnd2=op2})
         end

      val conv-scale conv sz x =
         do op <- conv-with conv sz x.opnd;
            return
               (SEM_LIN_SCALE
                  {opnd=op,
                   imm=
                     case $imm x of
                        '00': 1
                      | '01': 2
                      | '10': 4
                      | '11': 8
                     end})
         end

Julian Kranz's avatar
Julian Kranz committed
173
      val conv-mem x = conv-with Signed x.psz x.opnd
mb0's avatar
Up.  
mb0 committed
174
175
176
177
178
179
   in
      case x of
         IMM8 x: conv-imm conv x
       | IMM16 x: conv-imm conv x
       | IMM32 x: conv-imm conv x
       | IMM64 x: conv-imm conv x
Julian Kranz's avatar
Julian Kranz committed
180
       | REG x: conv-reg conv sz x
mb0's avatar
Up.  
mb0 committed
181
182
183
       | SUM x: conv-sum conv sz x
       | SCALE x: conv-scale conv sz x
       | MEM x:
Julian Kranz's avatar
Julian Kranz committed
184
           do
Julian Kranz's avatar
Julian Kranz committed
185
186
	     t <- mktemp;
             address <- conv-mem x;
Julian Kranz's avatar
Julian Kranz committed
187
188
             segmented-load x.sz t x.psz address x.segment;
             expand conv (var t) x.sz sz
Julian Kranz's avatar
Julian Kranz committed
189
           end
mb0's avatar
Up.  
mb0 committed
190
191
192
      end
   end

Julian Kranz's avatar
Julian Kranz committed
193
val read sz x = conv-with Unsigned sz x
Julian Kranz's avatar
Julian Kranz committed
194
val reads conv sz x = conv-with conv sz x
Julian Kranz's avatar
Julian Kranz committed
195
196
197
198
199
200
201
202
203

val read-addr-reg x =
  case x of
     MEM m:
       case m.opnd of
          REG r: r
       end
  end

mb0's avatar
Up.  
mb0 committed
204
205
206
207
208
209
210
211
212
213
214
215
216
217
val read-flow sz x =
   let
      val conv-bv v = return (SEM_LIN_IMM{imm=sx v})
   in
      case x of
         REL8 x: conv-bv x
       | REL16 x: conv-bv x
       | REL32 x: conv-bv x
       | REL64 x: conv-bv x
       | NEARABS x: read sz x
       | FARABS x: read sz x
      end
   end

Julian Kranz's avatar
Julian Kranz committed
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
val near target =
  case target of
     REL8 x: '1'
   | REL16 x: '1'
   | REL32 x: '1'
   | REL64 x: '1'
   | NEARABS x: '1'
   | _: '0'
  end

val far target = not (near target)

val relative target =
  case target of
     REL8 x: '1'
   | REL16 x: '1'
   | REL32 x: '1'
   | REL64 x: '1'
   | _: '0'
  end

val absolute target = not (relative target)

Julian Kranz's avatar
Julian Kranz committed
241
val write-offset sz x offset =
mb0's avatar
Up.  
mb0 committed
242
   case x of
Julian Kranz's avatar
Julian Kranz committed
243
244
245
246
     MEM x:
       do
         #Todo: Offset for memory operands?
         address <- conv-with Signed x.psz x.opnd;
Julian Kranz's avatar
Julian Kranz committed
247
         return (SEM_WRITE_MEM{size=x.psz,address=address,segment=x.segment})
Julian Kranz's avatar
Julian Kranz committed
248
       end
mb0's avatar
Up.  
mb0 committed
249
    | REG x:
Julian Kranz's avatar
Julian Kranz committed
250
251
252
253
254
       do 
         id <- return (semantic-register-of x);
	 id <- return (@{offset=id.offset + offset} id);
         return (SEM_WRITE_VAR{size= $size id,id=id})
       end
mb0's avatar
Up.  
mb0 committed
255
256
   end

Julian Kranz's avatar
Julian Kranz committed
257

Julian Kranz's avatar
Julian Kranz committed
258
259
260
261
262
263
264
265
266
val write sz x = write-offset sz x 0
val write-upper sz x = write-offset sz x sz

val register? x =
  case x of
      REG: '1'
    | _: '0'
  end

mb0's avatar
Up.  
mb0 committed
267
268
269
val commit sz a b =
   case a of
      SEM_WRITE_MEM x:
Julian Kranz's avatar
Julian Kranz committed
270
         #store x (SEM_LIN{size=sz,opnd1=b})
Julian Kranz's avatar
Julian Kranz committed
271
	 segmented-store x (SEM_LIN{size=sz,opnd1=b}) x.segment
mb0's avatar
Up.  
mb0 committed
272
273
274
275
276
277
278
279
280
281
282
283
    | SEM_WRITE_VAR x:
         #TODO: no zero extension when not in 64bit mode
         case sz of
            32:
               case x.id.offset of
                  0:
                     do mov 32 x.id b;
                        # Zero the upper half of the given register/variable
                        mov 32 (@{offset=32} x.id) (SEM_LIN_IMM {imm=0})
                     end
                | _: mov sz x.id b
               end
Julian Kranz's avatar
Julian Kranz committed
284
          | _: mov sz x.id b
mb0's avatar
Up.  
mb0 committed
285
286
287
         end
   end

Axel Simon's avatar
Axel Simon committed
288
289
290
291
292
293
val fEQ = return (_var VIRT_EQ)
val fNEQ = return (_var VIRT_NEQ)
val fLES = return (_var VIRT_LES)
val fLEU = return (_var VIRT_LEU)
val fLTS = return (_var VIRT_LTS)
val fLTU = return (_var VIRT_LTU)
mb0's avatar
Up.  
mb0 committed
294
295
296

val zero = return (SEM_LIN_IMM{imm=0})

Julian Kranz's avatar
Julian Kranz committed
297
val _if c _then a _else b = do
Julian Kranz's avatar
Julian Kranz committed
298
  c <- c;
Julian Kranz's avatar
Julian Kranz committed
299
300
301
302
303
304
  stack <- pop-all;
  a;
  t <- pop-all;
  b;
  e <- pop-all;
  stack-set stack;
Julian Kranz's avatar
Julian Kranz committed
305
  ite c t e
Julian Kranz's avatar
Julian Kranz committed
306
307
308
309
310
311
312
313
end

val _if c _then a = do
  _if c _then a _else (return void)
end

val /d cond = return cond

Julian Kranz's avatar
Julian Kranz committed
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
val /and a b = do
  a <- a;
  b <- b;
  t <- mktemp;
  andb 1 t a b;
  return (var t)
end

val /or a b = do
  a <- a;
  b <- b;
  t <- mktemp;
  orb 1 t a b;
  return (var t)
end

val /not a = do
  t <- mktemp;
  xorb 1 t a (imm 1);
  return (var t)
end

Julian Kranz's avatar
Julian Kranz committed
336
337
338
339
340
341
342
343
344
345
val /eq sz a b = do
  t <- mktemp;
  cmpeq sz t a b;
  return (var t)
end

val /neq sz a b = do
  t <- mktemp;
  cmpneq sz t a b;
  return (var t)
Julian Kranz's avatar
Julian Kranz committed
346
347
end

Julian Kranz's avatar
Julian Kranz committed
348
349
350
351
352
353
354
val /gtu sz a b = do
  t <- mktemp;
  cmpleu sz t a b;
  xorb 1 t (var t) (imm 1);
  return (var t)
end

Julian Kranz's avatar
Julian Kranz committed
355
val _while c __ b = do
Julian Kranz's avatar
Julian Kranz committed
356
  c <- c;
Julian Kranz's avatar
Julian Kranz committed
357
358
359
360
361
362
363
  stack <- pop-all;
  b;
  body <- pop-all;
  stack-set stack;
  while c body
end

Julian Kranz's avatar
Julian Kranz committed
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
val sem-a sem-cc x = do
  cf <- fCF;
  zf <- fZF;
  sem-cc x (/and (/not (var cf)) (/not (var zf)))
end
val sem-nbe sem-cc x = sem-a sem-cc x

val sem-ae sem-cc x = do
  cf <- fCF;
  sem-cc x (/not (var cf))
end
val sem-nb sem-cc x = sem-ae sem-cc x
val sem-nc sem-cc x = sem-ae sem-cc x

val sem-c sem-cc x = do
  cf <- fCF;
  sem-cc x (/d (var cf))
end
val sem-b sem-cc x = sem-c sem-cc x
val sem-nae sem-cc x = sem-nae sem-cc x

val sem-be sem-cc x = do
  cf <- fCF;
  zf <- fZF;
  sem-cc x (/or (/d (var cf)) (/d (var zf)))
end
val sem-na sem-cc x = sem-be sem-cc x

val sem-e sem-cc x = do
  zf <- fZF;
  sem-cc x (/d (var zf))
end
val sem-z sem-cc x = sem-e sem-cc x

val sem-g sem-cc x = do
  zf <- fZF;
  sf <- fSF;
  ov <- fOF;
  sem-cc x (/and (/not (var zf)) (/eq 1 (var sf) (var ov)))
end
val sem-nle sem-cc x = sem-g sem-cc x

val sem-ge sem-cc x = do
  sf <- fSF;
  ov <- fOF;
  sem-cc x (/eq 1 (var sf) (var ov))
end
val sem-nl sem-cc x = sem-ge sem-cc x

val sem-l sem-cc x = do
  sf <- fSF;
  ov <- fOF;
  sem-cc x (/neq 1 (var sf) (var ov))
end
val sem-nge sem-cc x = sem-l sem-cc x

val sem-le sem-cc x = do
  zf <- fZF;
  sf <- fSF;
  ov <- fOF;
  sem-cc x (/or (/d (var zf)) (/neq 1 (var sf) (var ov)))
end
val sem-ng sem-cc x = sem-le sem-cc x

val sem-ne sem-cc x = do
  zf <- fZF;
  sem-cc x (/not (var zf))
end
val sem-nz sem-cc x = sem-ne sem-cc x

val sem-no sem-cc x = do
  ov <- fOF;
  sem-cc x (/not (var ov))
end

val sem-np sem-cc x = do
  pf <- fPF;
  sem-cc x (/not (var pf))
end
val sem-po sem-cc x = sem-np sem-cc x

val sem-ns sem-cc x = do
  sf <- fSF;
  sem-cc x (/not (var sf))
end

val sem-o sem-cc x = do
  ov <- fOF;
  sem-cc x (/d (var ov))
end

val sem-p sem-cc x = do
  pf <- fPF;
  sem-cc x (/d (var pf))
end
val sem-pe sem-cc x = sem-p sem-cc x

val sem-s sem-cc x = do
  sf <- fSF;
  sem-cc x (/d (var sf))
end

Julian Kranz's avatar
Julian Kranz committed
466
val undef-opnd opnd = do
Julian Kranz's avatar
Julian Kranz committed
467
  sz <- sizeof1 opnd;
Julian Kranz's avatar
Julian Kranz committed
468
469
  a <- write sz opnd;
  t <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
470
  commit sz a (var t)
Julian Kranz's avatar
Julian Kranz committed
471
472
473
474
475
end

val sem-undef-arity-ge1 x = do
  case x.opnd1 of
     REG r: undef-opnd x.opnd1
Julian Kranz's avatar
Julian Kranz committed
476
   | MEM m: undef-opnd x.opnd1
Julian Kranz's avatar
Julian Kranz committed
477
478
479
  end
end

Julian Kranz's avatar
Julian Kranz committed
480
val sem-undef-arity0 x = do
Julian Kranz's avatar
Julian Kranz committed
481
  return void
Julian Kranz's avatar
Julian Kranz committed
482
483
484
end

val sem-undef-arity1 x = do
Julian Kranz's avatar
Julian Kranz committed
485
  sem-undef-arity-ge1 x
Julian Kranz's avatar
Julian Kranz committed
486
487
488
end

val sem-undef-arity2 x = do
Julian Kranz's avatar
Julian Kranz committed
489
  sem-undef-arity-ge1 x
Julian Kranz's avatar
Julian Kranz committed
490
491
492
end

val sem-undef-arity3 x = do
Julian Kranz's avatar
Julian Kranz committed
493
  sem-undef-arity-ge1 x
Julian Kranz's avatar
Julian Kranz committed
494
495
496
end

val sem-undef-arity4 x = do
Julian Kranz's avatar
Julian Kranz committed
497
  sem-undef-arity-ge1 x
Julian Kranz's avatar
Julian Kranz committed
498
499
500
end

val sem-undef-varity x = do
Julian Kranz's avatar
Julian Kranz committed
501
502
503
504
505
506
  case x of
     VA1 x: sem-undef-arity1 x
   | VA2 x: sem-undef-arity2 x
   | VA3 x: sem-undef-arity3 x
   | VA4 x: sem-undef-arity4 x
  end
Julian Kranz's avatar
Julian Kranz committed
507
508
509
end

val sem-undef-flow1 x = do
Julian Kranz's avatar
Julian Kranz committed
510
  return void
Julian Kranz's avatar
Julian Kranz committed
511
512
end

Julian Kranz's avatar
Julian Kranz committed
513
val emit-parity-flag r = do
Julian Kranz's avatar
Julian Kranz committed
514
515
  byte-size <- return 8;

Julian Kranz's avatar
Julian Kranz committed
516
  low-byte <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
517
  mov byte-size low-byte r;
Julian Kranz's avatar
Julian Kranz committed
518
519

  pf <- fPF;
Julian Kranz's avatar
Julian Kranz committed
520
521
522
523
524
525
526
527
  # Bitwise XNOR
  cmpeq 1 pf (var (at-offset low-byte 7)) (var (at-offset low-byte 6));
  cmpeq 1 pf (var pf) (var (at-offset low-byte 5));
  cmpeq 1 pf (var pf) (var (at-offset low-byte 4));
  cmpeq 1 pf (var pf) (var (at-offset low-byte 3));
  cmpeq 1 pf (var pf) (var (at-offset low-byte 2));
  cmpeq 1 pf (var pf) (var (at-offset low-byte 1));
  cmpeq 1 pf (var pf) (var (at-offset low-byte 0))
Julian Kranz's avatar
Julian Kranz committed
528
529
end

Julian Kranz's avatar
Julian Kranz committed
530
val emit-arithmetic-adjust-flag sz r op0 op1 = do
Julian Kranz's avatar
Julian Kranz committed
531
532
  # Hacker's Delight - How the Computer Sets Overflow for Signed Add/Subtract
  t <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
533
534
  xorb sz t r op0;
  xorb sz t (var t) op1;
Julian Kranz's avatar
Julian Kranz committed
535
536
537
538

  andb sz t (var t) (imm 0x10);
  af <- fAF;
  cmpneq sz af (var t) (imm 0)
Julian Kranz's avatar
Julian Kranz committed
539
end
Julian Kranz's avatar
Julian Kranz committed
540

Julian Kranz's avatar
Julian Kranz committed
541
val emit-add-adc-flags sz sum s0 s1 carry set-carry = do
Julian Kranz's avatar
Julian Kranz committed
542
543
544
545
  eq <- fEQ;
  les <- fLES;
  leu <- fLEU;
  lts <- fLTS;
Julian Kranz's avatar
Julian Kranz committed
546
  ltu <- fLTU;
Julian Kranz's avatar
Julian Kranz committed
547
548
  sf <- fSF;
  ov <- fOF;
Julian Kranz's avatar
Julian Kranz committed
549
550
  z <- fZF;
  cf <- fCF;
Julian Kranz's avatar
Julian Kranz committed
551
552
553
554
  t1 <- mktemp;
  t2 <- mktemp;
  t3 <- mktemp;
  zer0 <- zero;
Julian Kranz's avatar
Julian Kranz committed
555
556
557
558

  cmpltu sz ltu s0 s1;
  xorb sz t1 sum s0;
  xorb sz t2 sum s1;
Julian Kranz's avatar
Julian Kranz committed
559
560
  andb sz t3 (var t1) (var t2);
  cmplts sz ov (var t3) zer0;
Julian Kranz's avatar
Julian Kranz committed
561
562
  cmplts sz sf sum zer0;
  cmpeq sz eq sum zer0;
Julian Kranz's avatar
Julian Kranz committed
563
564
565
  xorb 1 lts (var sf) (var ov);
  orb 1 leu (var ltu) (var eq);
  orb 1 les (var lts) (var eq);
Julian Kranz's avatar
Julian Kranz committed
566
567
568
  cmpeq sz z sum zer0;

  # Hacker's Delight - Unsigned Add/Subtract
Julian Kranz's avatar
Julian Kranz committed
569
570
571
572
573
574
575
576
577
  if set-carry then (
    _if (/d carry) _then do
      cmpleu sz cf sum s0
    end _else do
      cmpltu sz cf sum s0
    end
  ) else
    return void
  ;
Julian Kranz's avatar
Julian Kranz committed
578

Julian Kranz's avatar
Julian Kranz committed
579
  emit-parity-flag sum;
Julian Kranz's avatar
Julian Kranz committed
580
  emit-arithmetic-adjust-flag sz sum s0 s1
Julian Kranz's avatar
Julian Kranz committed
581
end
mb0's avatar
Up.  
mb0 committed
582

Julian Kranz's avatar
Julian Kranz committed
583
val emit-sub-sbb-flags sz difference minuend subtrahend carry set-carry = do
Julian Kranz's avatar
Julian Kranz committed
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
  eq <- fEQ;
  les <- fLES;
  leu <- fLEU;
  lts <- fLTS;
  ltu <- fLTU;
  sf <- fSF;
  ov <- fOF;
  cf <- fCF;
  z <- fZF;
  t1 <- mktemp;
  t2 <- mktemp;
  t3 <- mktemp;
  zer0 <- zero;

  cmpltu sz ltu minuend subtrahend;
  cmpleu sz leu minuend subtrahend;
  cmplts sz lts minuend subtrahend;
  cmples sz les minuend subtrahend;
  cmpeq sz eq minuend subtrahend;
  cmplts sz sf difference zer0;
  xorb 1 ov (var lts) (var sf);
  cmpeq sz z difference zer0;

Julian Kranz's avatar
Julian Kranz committed
607
608
609
610
611
612
613
614
615
616
  if set-carry then (
    # Hacker's Delight - Unsigned Add/Subtract
    _if (/d carry) _then do
      cmpleu sz cf minuend subtrahend
    end _else do
      cmpltu sz cf minuend subtrahend
    end
  ) else
    return void
  ;
Julian Kranz's avatar
Julian Kranz committed
617

Julian Kranz's avatar
Julian Kranz committed
618
  emit-parity-flag difference;
Julian Kranz's avatar
Julian Kranz committed
619
620
  emit-arithmetic-adjust-flag sz difference minuend subtrahend
end
mb0's avatar
Up.  
mb0 committed
621

Julian Kranz's avatar
Julian Kranz committed
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
val emit-mul-flags sz product = do
  ov <- fOF;
  cf <- fCF;
  sf <- fSF;
  zf <- fZF;
  af <- fAF;
  pf <- fPF;

  sgn-ext <- mktemp;
  movsx sz sgn-ext 1 (var (at-offset product (sz + sz - 1)));

  cmpneq sz ov (var (at-offset product sz)) (var sgn-ext);
  mov 1 cf (var ov);

  undef 1 sf;
  undef 1 zf;
  undef 1 af;
  undef 1 pf
end

Julian Kranz's avatar
Julian Kranz committed
642
643
644
645
646
647
648
649
650
651
652
653
val move-to-rflags size lin = do
  flags <- rflags;

  in-mask <- return 0x0000000000245fd5;
  out-mask <- return 0xffffffffffc3a02a;

  temp <- mktemp;
  andb size temp lin (imm in-mask);
  andb size flags (var flags) (imm out-mask);
  orb size flags (var flags) (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
val direction-adjust reg-size reg-sem for-size = do
  amount <-
    case for-size of
       8: return 1
     | 16: return 2
     | 32: return 4
     | 64: return 8
    end
  ;

  df <- fDF;
  _if (/not (var df)) _then
    add reg-size reg-sem (var reg-sem) (imm amount)  
  _else
    sub reg-size reg-sem (var reg-sem) (imm amount)
end

Julian Kranz's avatar
Julian Kranz committed
671
672
## A>>

Julian Kranz's avatar
Julian Kranz committed
673
val sem-adc x = do
Julian Kranz's avatar
Julian Kranz committed
674
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
675
676
677
678
679
680
681
682
683
684
685
686
  a <- write sz x.opnd1;
  b <- read sz x.opnd1;
  c <- read sz x.opnd2;

  t <- mktemp;
  add sz t b c;

  cf <- fCF;
  tc <- mktemp;
  movzx sz tc 1 (var cf);
  add sz t (var t) (var tc);

Julian Kranz's avatar
Julian Kranz committed
687
  emit-add-adc-flags sz (var t) b c (var cf) '1';
Julian Kranz's avatar
Julian Kranz committed
688
689
690
  commit sz a (var t)
end

Julian Kranz's avatar
Julian Kranz committed
691
val sem-add x = do
Julian Kranz's avatar
Julian Kranz committed
692
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
693
694
695
696
697
  a <- write sz x.opnd1;
  b <- read sz x.opnd1;
  c <- read sz x.opnd2;
  t <- mktemp;
  add sz t b c;
Julian Kranz's avatar
Julian Kranz committed
698
  emit-add-adc-flags sz (var t) b c (imm 0) '1';
Julian Kranz's avatar
Julian Kranz committed
699
700
  commit sz a (var t)
end
mb0's avatar
Up.  
mb0 committed
701

Julian Kranz's avatar
Julian Kranz committed
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
#val sem-addpd x = do
#  size <- return 128;
#
#end

val sem-andpd x = do
  size <- return 128;

  src0 <- read size x.opnd1;
  src1 <- read size x.opnd2;

  temp <- mktemp;
  andb size temp src0 src1;

  dst <- write size x.opnd1;
  commit size dst (var temp)
end

val sem-vandpd x = do
  size <- sizeof1 x.opnd1;
  src0 <- read size x.opnd2;
  src1 <- read size x.opnd3;
  out-size <- return 256;
  
  temp <- mktemp;
  andb size temp src0 src1;

  mov (out-size - size) (at-offset temp size) (imm 0);

  dst <- return (semantic-register-of-operand-with-size x.opnd1 out-size);
  mov out-size dst (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
735
736
## B>>

Julian Kranz's avatar
Julian Kranz committed
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
val sem-bt x = do
  base-sz <- sizeof1 x.opnd1;
  base <- read base-sz x.opnd1;
  offset-sz <- sizeof1 x.opnd2;
  offset <- read offset-sz x.opnd2;

  offset-real-sz <-
    case base-sz of
       16: return 4
     | 32: return 5
     | 64: return 6
    end
  ;

  offset-ext <- mktemp;
  mov offset-real-sz offset-ext offset;
  mov (base-sz - offset-real-sz) (at-offset offset-ext offset-real-sz) (imm 0);
  
  shifted <- mktemp;
  shr base-sz shifted base (var offset-ext);
  
  cf <- fCF;
Julian Kranz's avatar
Julian Kranz committed
759
760
761
762
763
764
765
766
767
768
  mov 1 cf (var shifted);

  ov <- fOF;
  sf <- fSF;
  af <- fAF;
  pf <- fPF;
  undef 1 ov;
  undef 1 sf;
  undef 1 af;
  undef 1 pf
Julian Kranz's avatar
Julian Kranz committed
769
770
end

Julian Kranz's avatar
Julian Kranz committed
771
772
## C>>

Julian Kranz's avatar
Julian Kranz committed
773
val sem-call x = do
Julian Kranz's avatar
Julian Kranz committed
774
  ip-sz <-
Julian Kranz's avatar
Julian Kranz committed
775
    if (x.opnd-sz === 64) then
Julian Kranz's avatar
Julian Kranz committed
776
777
778
779
      return 64
    else
      return 32
  ;
Julian Kranz's avatar
Julian Kranz committed
780
  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
781
  
Julian Kranz's avatar
Julian Kranz committed
782
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
783
  ip <- ip-get;
Julian Kranz's avatar
Julian Kranz committed
784
785
786
787
788
789
  if (near x.opnd1) then do
    target <- read-flow ip-sz x.opnd1;
    if (relative x.opnd1) then do
      add ip-sz temp-ip ip target;
      if (x.opnd-sz === 16) then
          mov (ip-sz - x.opnd-sz) (at-offset temp-ip x.opnd-sz) (imm 0)
Julian Kranz's avatar
Julian Kranz committed
790
      else
Julian Kranz's avatar
Julian Kranz committed
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
         return void
    end else
      mov ip-sz temp-ip target
    ;
    ps-push ip-sz ip
  end else do
    sec-reg <- return CS;
    sec-reg-sem <- return (semantic-register-of sec-reg);
    reg-size <- sizeof1 (REG sec-reg);
    sec-reg-extended <- mktemp;
    movzx x.opnd-sz sec-reg-extended reg-size (var sec-reg-sem);
    ps-push x.opnd-sz (var sec-reg-extended);
    ps-push ip-sz ip;
  
    target-sz <- sizeof-flow x.opnd1;
    target <- read-flow target-sz x.opnd1;

    temp-target <- mktemp;
    mov target-sz temp-target target;
    mov reg-size sec-reg-sem (var (at-offset temp-target x.opnd-sz));
Julian Kranz's avatar
Julian Kranz committed
811

Julian Kranz's avatar
Julian Kranz committed
812
813
814
815
    temp-ip <- mktemp;
    movzx ip-sz temp-ip x.opnd-sz target
  end;
    
Julian Kranz's avatar
Julian Kranz committed
816
  call (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
817
818
end

Julian Kranz's avatar
Julian Kranz committed
819
820
821
822
823
val sem-cdqe = do
  a <- return (semantic-register-of RAX);
  movsx 64 a 32 (var a)
end

Julian Kranz's avatar
Julian Kranz committed
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
val sem-clc = do
  cf <- fCF;
  mov 1 cf (imm 0)
end

val sem-cld = do
  df <- fDF;
  mov 1 df (imm 0)
end

val sem-cmc = do
  cf <- fCF;
  xorb 1 cf (var cf) (imm 1)
end

Julian Kranz's avatar
Julian Kranz committed
839
val sem-cmovcc x cond = do
Julian Kranz's avatar
Julian Kranz committed
840
841
842
  sz <- sizeof1 x.opnd1;
  dst <- write sz x.opnd1;
  dst-read <- read sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
843

Julian Kranz's avatar
Julian Kranz committed
844
  src <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
845
846

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
847
  mov sz temp dst-read;
Julian Kranz's avatar
Julian Kranz committed
848
849

  _if cond _then
Julian Kranz's avatar
Julian Kranz committed
850
    mov sz temp src
Julian Kranz's avatar
Julian Kranz committed
851
852
  ;

Julian Kranz's avatar
Julian Kranz committed
853
  commit sz dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
854
855
end

Julian Kranz's avatar
Julian Kranz committed
856
val sem-cmp x = do
Julian Kranz's avatar
Julian Kranz committed
857
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
858
859
860
861
862
  a <- write sz x.opnd1;
  b <- read sz x.opnd1;
  c <- read sz x.opnd2;
  t <- mktemp;
  sub sz t b c;
Julian Kranz's avatar
Julian Kranz committed
863
  emit-sub-sbb-flags sz (var t) b c (imm 0) '1'
Julian Kranz's avatar
Julian Kranz committed
864
end
mb0's avatar
Up.  
mb0 committed
865

Julian Kranz's avatar
Julian Kranz committed
866
val sem-cmps x = do
Julian Kranz's avatar
Julian Kranz committed
867
  src0 <- read x.opnd-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
868
  src1-sz <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
869
  src1 <- read x.opnd-sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
870
871

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
872
873
  sub x.opnd-sz temp src0 src1;
  emit-sub-sbb-flags x.opnd-sz (var temp) src0 src1 (imm 0) '1';
Julian Kranz's avatar
Julian Kranz committed
874

Julian Kranz's avatar
Julian Kranz committed
875
876
877
  reg0-sem <- return (semantic-register-of (read-addr-reg x.opnd1));
  reg1-sem <- return (semantic-register-of (read-addr-reg x.opnd2));

Julian Kranz's avatar
Julian Kranz committed
878
879
  direction-adjust x.addr-sz reg0-sem x.opnd-sz;
  direction-adjust x.addr-sz reg1-sem x.opnd-sz
Julian Kranz's avatar
Julian Kranz committed
880

Julian Kranz's avatar
Julian Kranz committed
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
#  addr-sz <- address-size;
#
#  reg0 <-
#    case addr-sz of
#       16: return SI
#     | 32: return ESI
#     | 64: return RSI
#    end
#  ;
#  reg0-sem <- return (semantic-register-of reg0);
#  reg0-sz <- sizeof1 (REG reg0);
#  
#  #Todo: Fix, use specified segment
#  reg0-segment <- segment DS;
#  src0 <- read sz (MEM{sz=sz,psz=addr-sz,segment=reg0-segment,opnd=REG reg0});
#
#  reg1 <-
#    case addr-sz of
#       16: return DI
#     | 32: return EDI
#     | 64: return RDI
#    end
#  ;
#  reg1-sem <- return (semantic-register-of reg1);
#  reg1-sz <- sizeof1 (REG reg1);
#  reg1-segment <- segment ES;
#  src1 <- read sz (MEM{sz=sz,psz=addr-sz,segment=reg1-segment,opnd=REG reg1});
#
Julian Kranz's avatar
Julian Kranz committed
909
end
Julian Kranz's avatar
Julian Kranz committed
910
911
912
913
#val sem-cmpsb = sem-cmps 8
#val sem-cmpsw = sem-cmps 16
#val sem-cmpsd = sem-cmps 32
#val sem-cmpsq = sem-cmps 64
Julian Kranz's avatar
Julian Kranz committed
914

Julian Kranz's avatar
Julian Kranz committed
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
val sem-cwd-cdq-cqo x = do
  src <-
    case x.opnd-sz of
       16: return AX
     | 32: return EAX
     | 64: return RAX
    end
  ;
  src-sem <- return (semantic-register-of src);
  
  temp <- mktemp;
  movsx (src-sem.size + src-sem.size) temp src-sem.size (var src-sem);

  dst-high <-
    case x.opnd-sz of
       16: return DX
     | 32: return EDX
     | 64: return RDX
    end
  ;
  
  dst-high-sem <- return (semantic-register-of dst-high);
  mov dst-high-sem.size dst-high-sem (var (at-offset temp src-sem.size))
end

## D>>
Julian Kranz's avatar
Julian Kranz committed
941
942
943
944
945
946
947
948
949
950
951
952
953
954

val sem-dec x = do
  sz <- sizeof1 x.opnd1;
  src <- read sz x.opnd1;
  dst <- write sz x.opnd1;

  temp <- mktemp;
  sub sz temp src (imm 1);
  
  emit-sub-sbb-flags sz (var temp) src (imm 1) (imm 0) '0';

  commit sz dst (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
955
val sem-div signedness x = do
Julian Kranz's avatar
Julian Kranz committed
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
  sz <- sizeof1 x.opnd1;
  divisor <- read (sz + sz) x.opnd1;

  combine <-
    let
      val c high low = do
         high <- return (semantic-register-of high);
         low <- return (semantic-register-of low);

	 sz <- return high.size;

	 combined <- mktemp;
	 mov sz combined (var (at-offset high sz));
	 mov sz combined (var low);

	 return combined
      end
    in
      return c
    end
  ;

  dividend <-
    case sz of
       8: return (semantic-register-of AX)
Julian Kranz's avatar
Julian Kranz committed
981
     | _: combine (register-by-size low D sz) (register-by-size low A sz)
Julian Kranz's avatar
Julian Kranz committed
982
983
984
985
    end
  ;

  quotient <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
986
987
988
989
990
  #Todo: Handle exception
  case signedness of
     Unsigned: div (sz + sz) quotient (var dividend) divisor
   | Signed: divs (sz + sz) quotient (var dividend) divisor
  end;
Julian Kranz's avatar
Julian Kranz committed
991
  quotient-sem <- return (semantic-register-of (register-by-size low A sz));
Julian Kranz's avatar
Julian Kranz committed
992
993
994
995
996
997
998
  mov sz quotient-sem (var quotient);

  remainder <- mktemp;
  modulo (sz + sz) remainder (var dividend) divisor;
  remainder-sem <-
    case sz of
       8: return (semantic-register-of AH)
Julian Kranz's avatar
Julian Kranz committed
999
     | _: return (semantic-register-of (register-by-size high D sz))
Julian Kranz's avatar
Julian Kranz committed
1000
    end