x86-rreil-translator.ml 65.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
	     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
## A>>

Julian Kranz's avatar
Julian Kranz committed
643
val sem-adc x = do
Julian Kranz's avatar
Julian Kranz committed
644
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
645 646 647 648 649 650 651 652 653 654 655 656
  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
657
  emit-add-adc-flags sz (var t) b c (var cf) '1';
Julian Kranz's avatar
Julian Kranz committed
658 659 660
  commit sz a (var t)
end

Julian Kranz's avatar
Julian Kranz committed
661
val sem-add x = do
Julian Kranz's avatar
Julian Kranz committed
662
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
663 664 665 666 667
  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
668
  emit-add-adc-flags sz (var t) b c (imm 0) '1';
Julian Kranz's avatar
Julian Kranz committed
669 670
  commit sz a (var t)
end
mb0's avatar
Up.  
mb0 committed
671

Julian Kranz's avatar
Julian Kranz committed
672 673
## B>>

Julian Kranz's avatar
Julian Kranz committed
674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695
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
696 697 698 699 700 701 702 703 704 705
  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
706 707
end

Julian Kranz's avatar
Julian Kranz committed
708 709
## C>>

Julian Kranz's avatar
Julian Kranz committed
710
val sem-call x = do
Julian Kranz's avatar
Julian Kranz committed
711
  ip-sz <-
Julian Kranz's avatar
Julian Kranz committed
712
    if (x.opnd-sz === 64) then
Julian Kranz's avatar
Julian Kranz committed
713 714 715 716
      return 64
    else
      return 32
  ;
Julian Kranz's avatar
Julian Kranz committed
717
  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
718
  
Julian Kranz's avatar
Julian Kranz committed
719
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
720
  ip <- ip-get;
Julian Kranz's avatar
Julian Kranz committed
721 722 723 724 725 726
  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
727
      else
Julian Kranz's avatar
Julian Kranz committed
728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747
         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
748

Julian Kranz's avatar
Julian Kranz committed
749 750 751 752
    temp-ip <- mktemp;
    movzx ip-sz temp-ip x.opnd-sz target
  end;
    
Julian Kranz's avatar
Julian Kranz committed
753
  call (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
754 755
end

Julian Kranz's avatar
Julian Kranz committed
756 757 758 759 760
val sem-cdqe = do
  a <- return (semantic-register-of RAX);
  movsx 64 a 32 (var a)
end

Julian Kranz's avatar
Julian Kranz committed
761 762 763 764 765 766 767 768 769 770 771 772 773 774 775
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
776
val sem-cmovcc x cond = do
Julian Kranz's avatar
Julian Kranz committed
777 778 779
  sz <- sizeof1 x.opnd1;
  dst <- write sz x.opnd1;
  dst-read <- read sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
780

Julian Kranz's avatar
Julian Kranz committed
781
  src <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
782 783

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
784
  mov sz temp dst-read;
Julian Kranz's avatar
Julian Kranz committed
785 786

  _if cond _then
Julian Kranz's avatar
Julian Kranz committed
787
    mov sz temp src
Julian Kranz's avatar
Julian Kranz committed
788 789
  ;

Julian Kranz's avatar
Julian Kranz committed
790
  commit sz dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
791 792
end

Julian Kranz's avatar
Julian Kranz committed
793
val sem-cmp x = do
Julian Kranz's avatar
Julian Kranz committed
794
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
795 796 797 798 799
  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
800
  emit-sub-sbb-flags sz (var t) b c (imm 0) '1'
Julian Kranz's avatar
Julian Kranz committed
801
end
mb0's avatar
Up.  
mb0 committed
802

Julian Kranz's avatar
Julian Kranz committed
803
val sem-cmps x = do
Julian Kranz's avatar
Julian Kranz committed
804 805
  opnd-sz <- return x.opnd-sz;
  src0 <- read opnd-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
806
  src1-sz <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
807
  src1 <- read opnd-sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
808 809

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
810
  sub opnd-sz temp src0 src1;
Julian Kranz's avatar
Julian Kranz committed
811
  emit-sub-sbb-flags opnd-sz (var temp) src0 src1 (imm 0) '1';
Julian Kranz's avatar
Julian Kranz committed
812 813

  amount <-
Julian Kranz's avatar
Julian Kranz committed
814
    case opnd-sz of
Julian Kranz's avatar
Julian Kranz committed
815 816 817 818 819 820 821
       8: return 1
     | 16: return 2
     | 32: return 4
     | 64: return 8
    end
  ;

Julian Kranz's avatar
Julian Kranz committed
822 823 824 825
  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
826 827
  df <- fDF;
  _if (/not (var df)) _then do
Julian Kranz's avatar
Julian Kranz committed
828 829
    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
830
  end _else do
Julian Kranz's avatar
Julian Kranz committed
831 832
    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
833 834
  end

Julian Kranz's avatar
Julian Kranz committed
835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862
#  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
863
end
Julian Kranz's avatar
Julian Kranz committed
864 865 866 867
#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
868

Julian Kranz's avatar
Julian Kranz committed
869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894
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
895 896 897 898 899 900 901 902 903 904 905 906 907 908

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
909
val sem-div signedness x = do
Julian Kranz's avatar
Julian Kranz committed
910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934
  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
935
     | _: combine (register-by-size low D sz) (register-by-size low A sz)
Julian Kranz's avatar
Julian Kranz committed
936 937 938 939
    end
  ;

  quotient <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
940 941 942 943 944
  #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
945
  quotient-sem <- return (semantic-register-of (register-by-size low A sz));
Julian Kranz's avatar
Julian Kranz committed
946 947 948 949 950 951 952
  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
953
     | _: return (semantic-register-of (register-by-size high D sz))
Julian Kranz's avatar
Julian Kranz committed
954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972
    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
973 974 975 976
## E>>
## F>>
## G>>
## H>>
Julian Kranz's avatar
Julian Kranz committed
977

Julian Kranz's avatar
Julian Kranz committed
978 979 980 981
val sem-hlt = do
  return void
end

Julian Kranz's avatar
Julian Kranz committed
982 983 984 985
## I>>

val sem-idiv x = sem-div Signed x

Julian Kranz's avatar
Julian Kranz committed
986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003
val sem-imul-1 x = sem-mul Signed x
val sem-imul-2-3 op1 op2 op3 = do
  sz <- sizeof1 op1;

  factor0 <- reads Signed (sz + sz) op2;
  factor1 <- reads Signed (sz + sz) op3;

  product <- mktemp;
  mul (sz + sz) product factor0 factor1;

  emit-mul-flags sz product;

  result <- write sz op1;
  commit sz result (var product)
end
val sem-imul-2 x = sem-imul-2-3 x.opnd1 x.opnd1 x.opnd2
val sem-imul-3 x = sem-imul-2-3 x.opnd1 x.opnd2 x.opnd3

Julian Kranz's avatar
Julian Kranz committed
1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016
val sem-inc x = do
  sz <- sizeof1 x.opnd1;
  src <- read sz x.opnd1;
  dst <- write sz x.opnd1;

  temp <- mktemp;
  add 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
1017 1018
## J>>

Julian Kranz's avatar
Julian Kranz committed
1019 1020
val sem-jcc x cond = do
  ip-sz <-
Julian Kranz's avatar
Julian Kranz committed
1021
    if (x.opnd-sz === 64) then
Julian Kranz's avatar
Julian Kranz committed
1022 1023 1024 1025 1026 1027
      return 64
    else
      return 32
  ;
  ip <- ip-get;

Julian Kranz's avatar
Julian Kranz committed
1028
  target <- read-flow ip-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1029 1030

  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1031
  add ip-sz temp-ip target ip;
Julian Kranz's avatar
Julian Kranz committed
1032

Julian Kranz's avatar
Julian Kranz committed
1033 1034
  cond <- cond;
  cbranch cond (address ip-sz (var temp-ip)) (address ip-sz ip)
Julian Kranz's avatar
Julian Kranz committed
1035 1036 1037 1038 1039 1040
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
1041 1042
end

Julian Kranz's avatar
Julian Kranz committed
1043 1044 1045 1046
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
1047
val sem-jmp x = do
Julian Kranz's avatar
Julian Kranz committed
1048
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
1049 1050 1051 1052 1053 1054 1055
  ip-sz <-
    if mode64 then
      return 64
    else
      return 32
  ;
  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1056 1057 1058 1059 1060 1061 1062

  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
1063
      mov ip-sz temp-ip target
Julian Kranz's avatar
Julian Kranz committed
1064 1065 1066 1067 1068 1069
    ;
    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
1070
    end
Julian Kranz's avatar
Julian Kranz committed
1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087
  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
1088 1089 1090
    return void
  ;

Julian Kranz's avatar
Julian Kranz committed
1091
  jump (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
1092 1093
end

Julian Kranz's avatar
Julian Kranz committed
1094 1095 1096
## K>>
## L>>

Julian Kranz's avatar
Julian Kranz committed
1097 1098 1099 1100 1101 1102 1103
val sem-lahf = do
  ah <- return (semantic-register-of AH);
  flags <- eflags-low;

  mov ah.size ah (var flags)
end

Julian Kranz's avatar
Julian Kranz committed
1104 1105 1106 1107
val sem-lar x = do
  sem-undef-arity2
end

Julian Kranz's avatar
Julian Kranz committed
1108
val sem-lea x = do
Julian Kranz's avatar
Julian Kranz committed
1109
  opnd-sz <- sizeof1 x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124
  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
1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140
val sem-lods x = do
  sz <- sizeof1 x.opnd1;
  src <- read sz x.opnd1;

  dst <- return (semantic-register-of(
    case sz of
       8: AL
     | 16: AX
     | 32: EAX
     | 64: RAX
    end
  ));

  mov dst.size dst src
end

Julian Kranz's avatar
Julian Kranz committed
1141 1142
## M>>

Julian Kranz's avatar
Julian Kranz committed
1143
val sem-mov x = do
Julian Kranz's avatar
Julian Kranz committed
1144
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1145
  a <- write sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1146
  b <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1147 1148
  commit sz a b
end
mb0's avatar
Up.  
mb0 committed
1149

Julian Kranz's avatar
Julian Kranz committed
1150
val sem-movap x = do
Julian Kranz's avatar
Julian Kranz committed
1151 1152 1153 1154 1155 1156 1157 1158 1159 1160
  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
1161 1162 1163
val sem-vmovap x = do
  x <- case x of VA2 x: return x end;

Julian Kranz's avatar
Julian Kranz committed
1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181
  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
  ;

  temp <- mktemp;
  mov sz temp src;
  commit sz dst (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
1182 1183 1184 1185 1186 1187 1188 1189 1190
val sem-movsx x = do
  sz-dst <- sizeof1 x.opnd1;
  sz-src <- sizeof1 x.opnd2;
  dst <- write sz-dst x.opnd1;
  src <- read sz-src x.opnd2;

  temp <- mktemp;
  movsx sz-dst temp sz-src src;

Julian Kranz's avatar
Julian Kranz committed
1191
  commit sz-dst dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
1192 1193
end

Julian Kranz's avatar
Julian Kranz committed
1194
val sem-movzx x = do
Julian Kranz's avatar
Julian Kranz committed
1195 1196
  sz-dst <- sizeof1 x.opnd1;
  sz-src <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1197 1198 1199 1200 1201 1202
  dst <- write sz-dst x.opnd1;
  src <- read sz-src x.opnd2;

  temp <- mktemp;
  movzx sz-dst temp sz-src src;

Julian Kranz's avatar
Julian Kranz committed
1203
  commit sz-dst dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
1204 1205
end

Julian Kranz's avatar
Julian Kranz committed
1206
val sem-mul conv x = do
Julian Kranz's avatar
Julian Kranz committed
1207 1208 1209
  sz <- sizeof1 x.opnd1;

  factor0-sem <- return (semantic-register-of (register-by-size low A sz));
Julian Kranz's avatar
Julian Kranz committed
1210
  factor0 <- expand conv (var factor0-sem) sz (sz + sz);
Julian Kranz's avatar
Julian Kranz committed
1211

Julian Kranz's avatar
Julian Kranz committed
1212
  factor1 <- reads conv (sz + sz) x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1213 1214 1215 1216

  product <- mktemp;
  mul (sz + sz) product factor0 factor1;

Julian Kranz's avatar
Julian Kranz committed
1217 1218
  emit-mul-flags sz product;

Julian Kranz's avatar
Julian Kranz committed
1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230
  case sz of
     8: do
       ax <- return (semantic-register-of AX);
       mov sz ax (var product)
     end
   | _: do
       high <- return (semantic-register-of (register-by-size low D sz));
       low <- return (semantic-register-of (register-by-size low A sz));

       mov sz high (var (at-offset product sz));
       mov sz low (var product)
   end
Julian Kranz's avatar
Julian Kranz committed
1231
  end
Julian Kranz's avatar
Julian Kranz committed
1232 1233 1234 1235
end

## N>>

Julian Kranz's avatar
Julian Kranz committed
1236 1237 1238 1239
val sem-nop x = do
  return void
end

Julian Kranz's avatar
Julian Kranz committed
1240 1241
## O>>

Julian Kranz's avatar
Julian Kranz committed
1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264
val sem-or x = do
  sz <- sizeof2 x.opnd1 x.opnd2;
  dst <- write sz x.opnd1;
  src0 <- read sz x.opnd1;
  src1 <- read sz x.opnd2;
  temp <- mktemp;
  orb sz temp src0 src1;

  ov <- fOF;
  mov 1 ov (imm 0);
  cf <- fCF;
  mov 1 cf (imm 0);
  sf <- fSF;
  cmplts sz sf (var temp) (imm 0);
  zf <- fZF;
  cmpeq sz zf (var temp) (imm 0);
  emit-parity-flag (var temp);
  af <- fAF;
  undef 1 af;

  commit sz dst (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
1265 1266
## P>>

Julian Kranz's avatar
Julian Kranz committed
1267
val ps-pop opnd-sz opnd = do
Julian Kranz's avatar
Julian Kranz committed
1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279
  stack-addr-sz <- runtime-stack-address-size;

  sp-reg <-
    if stack-addr-sz === 32 then
      return ESP
    else if stack-addr-sz === 64 then
      return RSP
    else
      return SP
  ;
  
  sp <- return (semantic-register-of sp-reg);
Julian Kranz's avatar
Julian Kranz committed
1280
  sp-size <- sizeof1 (REG sp-reg);
Julian Kranz's avatar
Julian Kranz committed
1281

Julian Kranz's avatar
Julian Kranz committed
1282
  segmented-load opnd-sz opnd stack-addr-sz (var sp) (SEG_OVERRIDE SS);
Julian Kranz's avatar
Julian Kranz committed
1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300

  if stack-addr-sz === 32 then
    if opnd-sz === 32 then
      add sp-size sp (var sp) (imm 4)
    else
      add sp-size sp (var sp) (imm 2)
  else if stack-addr-sz === 64 then
    if opnd-sz === 64 then
      add sp-size sp (var sp) (imm 8)
    else
      add sp-size sp (var sp) (imm 2)
  else
    if opnd-sz === 16 then
      add sp-size sp (var sp) (imm 2)
    else
      add sp-size sp (var sp) (imm 4)

  #Todo: Special actions in protected mode
Julian Kranz's avatar
Julian Kranz committed
1301 1302
end

Julian Kranz's avatar
Julian Kranz committed
1303
val sem-pop x = do
Julian Kranz's avatar
Julian Kranz committed
1304
  dst <- write x.opnd-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1305
  temp-dest <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1306 1307
  ps-pop x.opnd-sz temp-dest;
  commit x.opnd-sz dst (var temp-dest)
Julian Kranz's avatar
Julian Kranz committed
1308 1309
end

Julian Kranz's avatar
Julian Kranz committed
1310
val ps-push opnd-sz opnd = do
Julian Kranz's avatar
Julian Kranz committed
1311
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
1312
  stack-addr-sz <- runtime-stack-address-size;
Julian Kranz's avatar
Julian Kranz committed
1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323
  
  sp-reg <-
    if mode64 then
      return RSP
    else if stack-addr-sz === 32 then
      return ESP
    else
      return SP
  ;
  sp <- return (semantic-register-of sp-reg);

Julian Kranz's avatar
Julian Kranz committed
1324
  if mode64 then
Julian Kranz's avatar
Julian Kranz committed
1325 1326 1327 1328
    if opnd-sz === 64 then
      sub sp.size sp (var sp) (imm 8)
    else
      sub sp.size sp (var sp) (imm 2)
Julian Kranz's avatar
Julian Kranz committed
1329
  else
Julian Kranz's avatar
Julian Kranz committed
1330 1331 1332 1333
    if opnd-sz === 32 then
      sub sp.size sp (var sp) (imm 4)
    else
      sub sp.size sp (var sp) (imm 2)
Julian Kranz's avatar
Julian Kranz committed
1334 1335 1336
  ;

  segmented-store (address sp.size (var sp)) (lin opnd-sz opnd) (SEG_OVERRIDE SS)
Julian Kranz's avatar
Julian Kranz committed
1337

Julian Kranz's avatar
Julian Kranz committed
1338
  #store (address sp.size (segment-add (var sp) segment)) (lin opnd-sz opnd)
Julian Kranz's avatar
Julian Kranz committed
1339 1340
end

Julian Kranz's avatar
Julian Kranz committed
1341 1342 1343 1344 1345 1346 1347 1348
val sem-push x = do
  src-size <- sizeof1 x.opnd1;
  src <- read src-size x.opnd1;

  temp <- mktemp;
  case x.opnd1 of
     REG r: 
       if segment-register? r then
Julian Kranz's avatar
Julian Kranz committed
1349
         movzx x.opnd-sz temp src-size src
Julian Kranz's avatar
Julian Kranz committed
1350
       else
Julian Kranz's avatar
Julian Kranz committed
1351
         mov x.opnd-sz temp src
Julian Kranz's avatar
Julian Kranz committed
1352
   | MEM m:
Julian Kranz's avatar
Julian Kranz committed
1353
       mov x.opnd-sz temp src
Julian Kranz's avatar
Julian Kranz committed
1354
   | IMM8 i:
Julian Kranz's avatar
Julian Kranz committed
1355
       movsx x.opnd-sz temp src-size src
Julian Kranz's avatar
Julian Kranz committed
1356
   | IMM16 i:
Julian Kranz's avatar
Julian Kranz committed
1357
       mov x.opnd-sz temp src
Julian Kranz's avatar
Julian Kranz committed
1358
   | IMM32 i:
Julian Kranz's avatar
Julian Kranz committed
1359
       movsx x.opnd-sz temp src-size src
Julian Kranz's avatar
Julian Kranz committed
1360 1361
  end;

Julian Kranz's avatar
Julian Kranz committed
1362
  ps-push x.opnd-sz (var temp)
Julian Kranz's avatar
Julian Kranz committed
1363 1364
end

Julian Kranz's avatar
Julian Kranz committed
1365 1366 1367
## Q>>
## R>>

Julian Kranz's avatar
Julian Kranz committed
1368 1369
val sem-ret x =
  case x of
Julian Kranz's avatar
Julian Kranz committed
1370
     VA0 x: sem-ret-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1371 1372
   | VA1 x:
       do
Julian Kranz's avatar
Julian Kranz committed
1373
         release-from-stack x;
Julian Kranz's avatar
Julian Kranz committed
1374
	 sem-ret-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1375 1376 1377
       end
  end

Julian Kranz's avatar
Julian Kranz committed
1378 1379
val sem-ret-far x =
  case x of
Julian Kranz's avatar
Julian Kranz committed
1380
     VA0 x: sem-ret-far-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1381 1382 1383
   | VA1 x:
       do
         release-from-stack x;
Julian Kranz's avatar
Julian Kranz committed
1384
         sem-ret-far-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1385 1386 1387
       end
  end

Julian Kranz's avatar
Julian Kranz committed
1388
val pop-ip opnd-sz = do
Julian Kranz's avatar
Julian Kranz committed
1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399
  ip-sz <-
    if (opnd-sz === 64) then
      return 64
    else
      return 32
  ;

  temp-ip <- mktemp;
  ps-pop ip-sz temp-ip;
  mov (ip-sz - opnd-sz) (at-offset temp-ip opnd-sz) (imm 0);

Julian Kranz's avatar
Julian Kranz committed
1400
  return (address opnd-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
1401 1402
end

Julian Kranz's avatar
Julian Kranz committed
1403 1404
val sem-ret-without-operand x = do
  address <- pop-ip x.opnd-sz;
Julian Kranz's avatar
Julian Kranz committed
1405 1406 1407
  ret address
end

Julian Kranz's avatar
Julian Kranz committed
1408 1409
val sem-ret-far-without-operand x = do
  address <- pop-ip x.opnd-sz;
Julian Kranz's avatar
Julian Kranz committed
1410 1411

  temp-cs <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1412
  ps-pop x.opnd-sz temp-cs;
Julian Kranz's avatar
Julian Kranz committed
1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423
  
  sec-reg <- return CS;
  sec-reg-sem <- return (semantic-register-of sec-reg);
  reg-size <- sizeof1 (REG sec-reg);

  mov reg-size sec-reg-sem (var temp-cs);

  ret address
end

val release-from-stack x = do
Julian Kranz's avatar
Julian Kranz committed
1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436
  x-sz <- sizeof1 x.opnd1;
  src <- read x-sz x.opnd1;

  stack-addr-sz <- runtime-stack-address-size;

  sp-reg <-
    if stack-addr-sz === 32 then
      return ESP
    else if stack-addr-sz === 64 then
      return RSP
    else
      return SP
  ;
Julian Kranz's avatar
Julian Kranz committed
1437

Julian Kranz's avatar
Julian Kranz committed
1438 1439 1440
  sp <- return (semantic-register-of sp-reg);
  sp-size <- sizeof1 (REG sp-reg);

Julian Kranz's avatar
Julian Kranz committed
1441 1442
  src-ext <- mktemp;
  movzx sp-size src-ext x-sz src;
Julian Kranz's avatar
Julian Kranz committed
1443