x86-rreil-translator.ml 67.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
356
357
358
359
360
361
362
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
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
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
465
val undef-opnd opnd = do
Julian Kranz's avatar
Julian Kranz committed
466
  sz <- sizeof1 opnd;
Julian Kranz's avatar
Julian Kranz committed
467
468
  a <- write sz opnd;
  t <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
469
  commit sz a (var t)
Julian Kranz's avatar
Julian Kranz committed
470
471
472
473
474
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
475
   | MEM m: undef-opnd x.opnd1
Julian Kranz's avatar
Julian Kranz committed
476
477
478
  end
end

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  # Hacker's Delight - Unsigned Add/Subtract
Julian Kranz's avatar
Julian Kranz committed
568
569
570
571
572
573
574
575
576
  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
577

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

Julian Kranz's avatar
Julian Kranz committed
582
val emit-sub-sbb-flags sz difference minuend subtrahend carry set-carry = do
Julian Kranz's avatar
Julian Kranz committed
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
  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
606
607
608
609
610
611
612
613
614
615
  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
616

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

Julian Kranz's avatar
Julian Kranz committed
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
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
641
642
643
644
645
646
647
648
649
650
651
652
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
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
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
670
671
## A>>

Julian Kranz's avatar
Julian Kranz committed
672
val sem-adc x = do
Julian Kranz's avatar
Julian Kranz committed
673
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
674
675
676
677
678
679
680
681
682
683
684
685
  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
686
  emit-add-adc-flags sz (var t) b c (var cf) '1';
Julian Kranz's avatar
Julian Kranz committed
687
688
689
  commit sz a (var t)
end

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

Julian Kranz's avatar
Julian Kranz committed
701
702
## B>>

Julian Kranz's avatar
Julian Kranz committed
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
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
725
726
727
728
729
730
731
732
733
734
  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
735
736
end

Julian Kranz's avatar
Julian Kranz committed
737
738
## C>>

Julian Kranz's avatar
Julian Kranz committed
739
val sem-call x = do
Julian Kranz's avatar
Julian Kranz committed
740
  ip-sz <-
Julian Kranz's avatar
Julian Kranz committed
741
    if (x.opnd-sz === 64) then
Julian Kranz's avatar
Julian Kranz committed
742
743
744
745
      return 64
    else
      return 32
  ;
Julian Kranz's avatar
Julian Kranz committed
746
  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
747
  
Julian Kranz's avatar
Julian Kranz committed
748
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
749
  ip <- ip-get;
Julian Kranz's avatar
Julian Kranz committed
750
751
752
753
754
755
  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
756
      else
Julian Kranz's avatar
Julian Kranz committed
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
         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
777

Julian Kranz's avatar
Julian Kranz committed
778
779
780
781
    temp-ip <- mktemp;
    movzx ip-sz temp-ip x.opnd-sz target
  end;
    
Julian Kranz's avatar
Julian Kranz committed
782
  call (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
783
784
end

Julian Kranz's avatar
Julian Kranz committed
785
786
787
788
789
val sem-cdqe = do
  a <- return (semantic-register-of RAX);
  movsx 64 a 32 (var a)
end

Julian Kranz's avatar
Julian Kranz committed
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
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
805
val sem-cmovcc x cond = do
Julian Kranz's avatar
Julian Kranz committed
806
807
808
  sz <- sizeof1 x.opnd1;
  dst <- write sz x.opnd1;
  dst-read <- read sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
809

Julian Kranz's avatar
Julian Kranz committed
810
  src <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
811
812

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
813
  mov sz temp dst-read;
Julian Kranz's avatar
Julian Kranz committed
814
815

  _if cond _then
Julian Kranz's avatar
Julian Kranz committed
816
    mov sz temp src
Julian Kranz's avatar
Julian Kranz committed
817
818
  ;

Julian Kranz's avatar
Julian Kranz committed
819
  commit sz dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
820
821
end

Julian Kranz's avatar
Julian Kranz committed
822
val sem-cmp x = do
Julian Kranz's avatar
Julian Kranz committed
823
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
824
825
826
827
828
  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
829
  emit-sub-sbb-flags sz (var t) b c (imm 0) '1'
Julian Kranz's avatar
Julian Kranz committed
830
end
mb0's avatar
Up.  
mb0 committed
831

Julian Kranz's avatar
Julian Kranz committed
832
val sem-cmps x = do
Julian Kranz's avatar
Julian Kranz committed
833
  src0 <- read x.opnd-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
834
  src1-sz <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
835
  src1 <- read x.opnd-sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
836
837

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
838
839
  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
840

Julian Kranz's avatar
Julian Kranz committed
841
842
843
  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
844
845
  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
846

Julian Kranz's avatar
Julian Kranz committed
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
#  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
875
end
Julian Kranz's avatar
Julian Kranz committed
876
877
878
879
#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
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
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
907
908
909
910
911
912
913
914
915
916
917
918
919
920

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
921
val sem-div signedness x = do
Julian Kranz's avatar
Julian Kranz committed
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
  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
947
     | _: combine (register-by-size low D sz) (register-by-size low A sz)
Julian Kranz's avatar
Julian Kranz committed
948
949
950
951
    end
  ;

  quotient <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
952
953
954
955
956
  #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
957
  quotient-sem <- return (semantic-register-of (register-by-size low A sz));
Julian Kranz's avatar
Julian Kranz committed
958
959
960
961
962
963
964
  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
965
     | _: return (semantic-register-of (register-by-size high D sz))
Julian Kranz's avatar
Julian Kranz committed
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
    end
  ;
  mov sz remainder-sem (var remainder);

  cf <- fCF;
  ov <- fOF;
  sf <- fSF;
  zf <- fZF;
  af <- fAF;
  pf <- fPF;

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

Julian Kranz's avatar
Julian Kranz committed
985
986
987
988
## E>>
## F>>
## G>>
## H>>
Julian Kranz's avatar
Julian Kranz committed
989

Julian Kranz's avatar
Julian Kranz committed
990
991
992
993
val sem-hlt = do
  return void
end

Julian Kranz's avatar
Julian Kranz committed
994
995
996
997
## I>>

val sem-idiv x = sem-div Signed x

Julian Kranz's avatar
Julian Kranz committed
998
999
1000
val sem-imul-1 x = sem-mul Signed x
val sem-imul-2-3 op1 op2 op3 = do
  sz <- sizeof1 op1;