x86-rreil-translator.ml 61.8 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
187
188
189
	     t <- mktemp;
             address <- conv-mem x;
             segmented-load sz t x.psz address x.segment;
             return (var t)
           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
195
196
197
198
199
200
201
202

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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
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
240
val write-offset sz x offset =
mb0's avatar
Up.  
mb0 committed
241
   case x of
Julian Kranz's avatar
Julian Kranz committed
242
243
244
245
     MEM x:
       do
         #Todo: Offset for memory operands?
         address <- conv-with Signed x.psz x.opnd;
Julian Kranz's avatar
Julian Kranz committed
246
         return (SEM_WRITE_MEM{size=x.psz,address=address,segment=x.segment})
Julian Kranz's avatar
Julian Kranz committed
247
       end
mb0's avatar
Up.  
mb0 committed
248
    | REG x:
Julian Kranz's avatar
Julian Kranz committed
249
250
251
252
253
       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
254
255
   end

Julian Kranz's avatar
Julian Kranz committed
256

Julian Kranz's avatar
Julian Kranz committed
257
258
259
260
261
262
263
264
265
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
266
267
268
val commit sz a b =
   case a of
      SEM_WRITE_MEM x:
Julian Kranz's avatar
Julian Kranz committed
269
         #store x (SEM_LIN{size=sz,opnd1=b})
Julian Kranz's avatar
Julian Kranz committed
270
	 segmented-store x (SEM_LIN{size=sz,opnd1=b}) x.segment
mb0's avatar
Up.  
mb0 committed
271
272
273
274
275
276
277
278
279
280
281
282
    | 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
283
          | _: mov sz x.id b
mb0's avatar
Up.  
mb0 committed
284
285
286
         end
   end

Axel Simon's avatar
Axel Simon committed
287
288
289
290
291
292
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
293
294
295

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

Julian Kranz's avatar
Julian Kranz committed
296
val _if c _then a _else b = do
Julian Kranz's avatar
Julian Kranz committed
297
  c <- c;
Julian Kranz's avatar
Julian Kranz committed
298
299
300
301
302
303
  stack <- pop-all;
  a;
  t <- pop-all;
  b;
  e <- pop-all;
  stack-set stack;
Julian Kranz's avatar
Julian Kranz committed
304
  ite c t e
Julian Kranz's avatar
Julian Kranz committed
305
306
307
308
309
310
311
312
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
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
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
335
336
337
338
339
340
341
342
343
344
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
345
346
end

Julian Kranz's avatar
Julian Kranz committed
347
348
349
350
351
352
353
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
354
355
356
357
358
359
360
361
val _while c __ b = do
  stack <- pop-all;
  b;
  body <- pop-all;
  stack-set stack;
  while c body
end

Julian Kranz's avatar
Julian Kranz committed
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
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
464
val undef-opnd opnd = do
Julian Kranz's avatar
Julian Kranz committed
465
  sz <- sizeof1 opnd;
Julian Kranz's avatar
Julian Kranz committed
466
467
  a <- write sz opnd;
  t <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
468
  commit sz a (var t)
Julian Kranz's avatar
Julian Kranz committed
469
470
471
472
473
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
474
   | MEM m: undef-opnd x.opnd1
Julian Kranz's avatar
Julian Kranz committed
475
476
477
  end
end

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

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

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

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

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

val sem-undef-varity x = do
Julian Kranz's avatar
Julian Kranz committed
499
500
501
502
503
504
  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
505
506
507
end

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

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

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

  pf <- fPF;
Julian Kranz's avatar
Julian Kranz committed
518
519
520
521
522
523
524
525
  # 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
526
527
end

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

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

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

  cmpltu sz ltu s0 s1;
  xorb sz t1 sum s0;
  xorb sz t2 sum s1;
Julian Kranz's avatar
Julian Kranz committed
557
558
  andb sz t3 (var t1) (var t2);
  cmplts sz ov (var t3) zer0;
Julian Kranz's avatar
Julian Kranz committed
559
560
  cmplts sz sf sum zer0;
  cmpeq sz eq sum zer0;
Julian Kranz's avatar
Julian Kranz committed
561
562
563
  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
564
565
566
  cmpeq sz z sum zer0;

  # Hacker's Delight - Unsigned Add/Subtract
Julian Kranz's avatar
Julian Kranz committed
567
  _if (/d carry) _then do
Julian Kranz's avatar
Julian Kranz committed
568
569
570
571
    cmpleu sz cf sum s0
  end _else do
    cmpltu sz cf sum s0
  end;
Julian Kranz's avatar
Julian Kranz committed
572

Julian Kranz's avatar
Julian Kranz committed
573
  emit-parity-flag sum;
Julian Kranz's avatar
Julian Kranz committed
574
  emit-arithmetic-adjust-flag sz sum s0 s1
Julian Kranz's avatar
Julian Kranz committed
575
end
mb0's avatar
Up.  
mb0 committed
576

Julian Kranz's avatar
Julian Kranz committed
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
val emit-sub-sbb-flags sz difference minuend subtrahend carry = do
  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;

  # Hacker's Delight - Unsigned Add/Subtract
Julian Kranz's avatar
Julian Kranz committed
602
  _if (/d carry) _then do
Julian Kranz's avatar
Julian Kranz committed
603
604
605
606
607
    cmpleu sz cf minuend subtrahend
  end _else do
    cmpltu sz cf minuend subtrahend
  end;

Julian Kranz's avatar
Julian Kranz committed
608
  emit-parity-flag difference;
Julian Kranz's avatar
Julian Kranz committed
609
610
  emit-arithmetic-adjust-flag sz difference minuend subtrahend
end
mb0's avatar
Up.  
mb0 committed
611

Julian Kranz's avatar
Julian Kranz committed
612
613
## A>>

Julian Kranz's avatar
Julian Kranz committed
614
val sem-adc x = do
Julian Kranz's avatar
Julian Kranz committed
615
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
616
617
618
619
620
621
622
623
624
625
626
627
  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
628
  emit-add-adc-flags sz (var t) b c (var cf);
Julian Kranz's avatar
Julian Kranz committed
629
630
631
  commit sz a (var t)
end

Julian Kranz's avatar
Julian Kranz committed
632
val sem-add x = do
Julian Kranz's avatar
Julian Kranz committed
633
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
634
635
636
637
638
  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
639
  emit-add-adc-flags sz (var t) b c (imm 0);
Julian Kranz's avatar
Julian Kranz committed
640
641
  commit sz a (var t)
end
mb0's avatar
Up.  
mb0 committed
642

Julian Kranz's avatar
Julian Kranz committed
643
644
## B>>

Julian Kranz's avatar
Julian Kranz committed
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
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
667
668
669
670
671
672
673
674
675
676
  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
677
678
end

Julian Kranz's avatar
Julian Kranz committed
679
680
## C>>

Julian Kranz's avatar
Julian Kranz committed
681
val sem-call x = do
Julian Kranz's avatar
Julian Kranz committed
682
  ip-sz <-
Julian Kranz's avatar
Julian Kranz committed
683
    if (x.opnd-sz === 64) then
Julian Kranz's avatar
Julian Kranz committed
684
685
686
687
      return 64
    else
      return 32
  ;
Julian Kranz's avatar
Julian Kranz committed
688
  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
689
  
Julian Kranz's avatar
Julian Kranz committed
690
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
691
  ip <- ip-get;
Julian Kranz's avatar
Julian Kranz committed
692
693
694
695
696
697
  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
698
      else
Julian Kranz's avatar
Julian Kranz committed
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
         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
719

Julian Kranz's avatar
Julian Kranz committed
720
721
722
723
    temp-ip <- mktemp;
    movzx ip-sz temp-ip x.opnd-sz target
  end;
    
Julian Kranz's avatar
Julian Kranz committed
724
  call (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
725
726
end

Julian Kranz's avatar
Julian Kranz committed
727
728
729
730
731
val sem-cdqe = do
  a <- return (semantic-register-of RAX);
  movsx 64 a 32 (var a)
end

Julian Kranz's avatar
Julian Kranz committed
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
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
747
val sem-cmovcc x cond = do
Julian Kranz's avatar
Julian Kranz committed
748
749
750
  sz <- sizeof1 x.opnd1;
  dst <- write sz x.opnd1;
  dst-read <- read sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
751

Julian Kranz's avatar
Julian Kranz committed
752
  src <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
753
754

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
755
  mov sz temp dst-read;
Julian Kranz's avatar
Julian Kranz committed
756
757

  _if cond _then
Julian Kranz's avatar
Julian Kranz committed
758
    mov sz temp src
Julian Kranz's avatar
Julian Kranz committed
759
760
  ;

Julian Kranz's avatar
Julian Kranz committed
761
  commit sz dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
762
763
end

Julian Kranz's avatar
Julian Kranz committed
764
val sem-cmp x = do
Julian Kranz's avatar
Julian Kranz committed
765
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
766
767
768
769
770
  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
771
  emit-sub-sbb-flags sz (var t) b c (imm 0)
Julian Kranz's avatar
Julian Kranz committed
772
end
mb0's avatar
Up.  
mb0 committed
773

Julian Kranz's avatar
Julian Kranz committed
774
val sem-cmps x = do
Julian Kranz's avatar
Julian Kranz committed
775
776
  opnd-sz <- return x.opnd-sz;
  src0 <- read opnd-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
777
  src1-sz <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
778
  src1 <- read opnd-sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
779
780

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
781
782
  sub opnd-sz temp src0 src1;
  emit-sub-sbb-flags opnd-sz (var temp) src0 src1 (imm 0);
Julian Kranz's avatar
Julian Kranz committed
783
784

  amount <-
Julian Kranz's avatar
Julian Kranz committed
785
    case opnd-sz of
Julian Kranz's avatar
Julian Kranz committed
786
787
788
789
790
791
792
       8: return 1
     | 16: return 2
     | 32: return 4
     | 64: return 8
    end
  ;

Julian Kranz's avatar
Julian Kranz committed
793
794
795
796
  reg0-sem <- return (semantic-register-of (read-addr-reg x.opnd1));
  reg1-sem <- return (semantic-register-of (read-addr-reg x.opnd2));
  addr-sz <- return x.addr-sz;

Julian Kranz's avatar
Julian Kranz committed
797
798
  df <- fDF;
  _if (/not (var df)) _then do
Julian Kranz's avatar
Julian Kranz committed
799
800
    add addr-sz reg0-sem (var reg0-sem) (imm amount); 
    add addr-sz reg1-sem (var reg1-sem) (imm amount)  
Julian Kranz's avatar
Julian Kranz committed
801
  end _else do
Julian Kranz's avatar
Julian Kranz committed
802
803
    sub addr-sz reg0-sem (var reg0-sem) (imm amount);  
    sub addr-sz reg1-sem (var reg1-sem) (imm amount)  
Julian Kranz's avatar
Julian Kranz committed
804
805
  end

Julian Kranz's avatar
Julian Kranz committed
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
#  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
834
end
Julian Kranz's avatar
Julian Kranz committed
835
836
837
838
#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
839

Julian Kranz's avatar
Julian Kranz committed
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
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>>
## E>>
## F>>
## G>>
## H>>
Julian Kranz's avatar
Julian Kranz committed
870

Julian Kranz's avatar
Julian Kranz committed
871
872
873
874
val sem-hlt = do
  return void
end

Julian Kranz's avatar
Julian Kranz committed
875
876
val sem-jcc x cond = do
  ip-sz <-
Julian Kranz's avatar
Julian Kranz committed
877
    if (x.opnd-sz === 64) then
Julian Kranz's avatar
Julian Kranz committed
878
879
880
881
882
883
      return 64
    else
      return 32
  ;
  ip <- ip-get;

Julian Kranz's avatar
Julian Kranz committed
884
  target <- read-flow ip-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
885
886

  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
887
  add ip-sz temp-ip target ip;
Julian Kranz's avatar
Julian Kranz committed
888

Julian Kranz's avatar
Julian Kranz committed
889
890
  cond <- cond;
  cbranch cond (address ip-sz (var temp-ip)) (address ip-sz ip)
Julian Kranz's avatar
Julian Kranz committed
891
892
893
894
895
896
end

val sem-jregz x reg = do
  reg-sem <- return (semantic-register-of reg);
  reg-size <- sizeof1 (REG reg);
  sem-jcc x (/eq reg-size (var reg-sem) (imm 0))
Julian Kranz's avatar
Julian Kranz committed
897
898
end

Julian Kranz's avatar
Julian Kranz committed
899
900
901
902
val sem-jcxz x = sem-jregz x CX
val sem-jecxz x = sem-jregz x ECX
val sem-jrcxz x = sem-jregz x RCX

Julian Kranz's avatar
Julian Kranz committed
903
val sem-jmp x = do
Julian Kranz's avatar
Julian Kranz committed
904
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
905
906
907
908
909
910
911
  ip-sz <-
    if mode64 then
      return 64
    else
      return 32
  ;
  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
912
913
914
915
916
917
918

  if (near x.opnd1) then do
    target <- read-flow ip-sz x.opnd1;
    if (relative x.opnd1) then do
      ip <- ip-get;
      add ip-sz temp-ip ip target
    end else
Julian Kranz's avatar
Julian Kranz committed
919
      mov ip-sz temp-ip target
Julian Kranz's avatar
Julian Kranz committed
920
921
922
923
924
925
    ;
    if (x.opnd-sz === 16) then
      #andb ip-sz temp-ip (var temp-ip) (imm 0xffff)
      mov (ip-sz - x.opnd-sz) (at-offset temp-ip x.opnd-sz) (imm 0)
    else
      return void
Julian Kranz's avatar
Julian Kranz committed
926
    end
Julian Kranz's avatar
Julian Kranz committed
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
  else if (not mode64) then do
    target-sz <- sizeof-flow x.opnd1;
    target <- read-flow target-sz x.opnd1;
    movzx ip-sz temp-ip x.opnd-sz target;
    #if (opnd-sz === 16) then
    #  #andb ip-sz temp-ip (var temp-ip) (imm 0xffff)
    #  mov (ip-sz - opnd-sz) (at-offset temp-ip x.opnd-sz) (imm 0)
    #else
    #  return void
    #;
    reg <- return CS;
    reg-sem <- return (semantic-register-of reg);
    reg-size <- sizeof1 (REG reg);
    temp-target <- mktemp;
    mov target-sz temp-target target;
    mov reg-size reg-sem (var (at-offset temp-target x.opnd-sz))
  end else
Julian Kranz's avatar
Julian Kranz committed
944
945
946
    return void
  ;

Julian Kranz's avatar
Julian Kranz committed
947
  jump (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
948
949
end

Julian Kranz's avatar
Julian Kranz committed
950
val sem-lea x = do
Julian Kranz's avatar
Julian Kranz committed
951
  opnd-sz <- sizeof1 x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
  dst <- write opnd-sz x.opnd1;
  src <-
    case x.opnd2 of
      MEM m: return m
    end
  ;
  addr-sz <- return src.psz;
  address <- conv-with Signed src.psz src.opnd;

  temp <- mktemp;
  movzx opnd-sz temp addr-sz address;

  commit opnd-sz dst (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
967
val sem-mov x = do
Julian Kranz's avatar
Julian Kranz committed
968
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
969
  a <- write sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
970
  b <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
971
972
  commit sz a b
end
mb0's avatar
Up.  
mb0 committed
973

Julian Kranz's avatar
Julian Kranz committed
974
val sem-movap x = do
Julian Kranz's avatar
Julian Kranz committed
975
976
977
978
979
980
981
982
983
984
  sz <- sizeof1 x.opnd1;
  dst <- write sz x.opnd1;
  src <- read sz x.opnd2;

  temp <- mktemp;
  mov sz temp src;

  commit sz dst (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
985
986
987
val sem-vmovap x = do
  x <- case x of VA2 x: return x end;

Julian Kranz's avatar
Julian Kranz committed
988
989
990
991
992
993
994
995
996
997
998
999
1000
  sz <- sizeof1 x.opnd1;
  dst <- write sz x.opnd1;
  src <- read sz x.opnd2;

  if sz === 128 then
    do
      dst-upper <- write-upper sz x.opnd1;
      commit sz dst-upper (imm 0)
    end
  else
    return void
  ;