x86-rreil-translator.ml 66.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
## 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
end

val sem-jregz x reg = do
  reg-sem <- return (semantic-register-of reg);
Julian Kranz's avatar
Julian Kranz committed
1039
  sem-jcc x (/eq reg-sem.size (var reg-sem) (imm 0))
Julian Kranz's avatar
Julian Kranz committed
1040 1041
end

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

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

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

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

Julian Kranz's avatar
Julian Kranz committed
1096 1097 1098 1099 1100 1101 1102
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
1103 1104 1105 1106
val sem-lar x = do
  sem-undef-arity2
end

Julian Kranz's avatar
Julian Kranz committed
1107
val sem-lea x = do
Julian Kranz's avatar
Julian Kranz committed
1108
  opnd-sz <- sizeof1 x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123
  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
1124 1125 1126 1127
val sem-lods x = do
  sz <- sizeof1 x.opnd1;
  src <- read sz x.opnd1;

Julian Kranz's avatar
Julian Kranz committed
1128
  dst <- return (semantic-register-of (
Julian Kranz's avatar
Julian Kranz committed
1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139
    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
1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170
val sem-loop-loop x = do
  reg <- return (semantic-register-of (
    case x.addr-sz of
       32: ECX
     | 64: RCX
     | _: CX
    end
  ));

  sub reg.size reg (var reg) (imm 1);

  return reg
end

val sem-loop x = do
  reg <- sem-loop-loop x;
  sem-jcc x (/neq reg.size (var reg) (imm 0))
end

val sem-loope x = do
  reg <- sem-loop-loop x;
  zf <- fZF;
  sem-jcc x (/and (/d (var zf)) (/neq reg.size (var reg) (imm 0)))
end

val sem-loopne x = do
  reg <- sem-loop-loop x;
  zf <- fZF;
  sem-jcc x (/and (/not (var zf)) (/neq reg.size (var reg) (imm 0)))
end

Julian Kranz's avatar
Julian Kranz committed
1171 1172
## M>>

Julian Kranz's avatar
Julian Kranz committed
1173
val sem-mov x = do
Julian Kranz's avatar
Julian Kranz committed
1174
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1175
  a <- write sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1176
  b <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1177 1178
  commit sz a b
end
mb0's avatar
Up.  
mb0 committed
1179

Julian Kranz's avatar
Julian Kranz committed
1180
val sem-movap x = do
Julian Kranz's avatar
Julian Kranz committed
1181 1182 1183 1184 1185 1186 1187 1188 1189 1190
  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
1191 1192 1193
val sem-vmovap x = do
  x <- case x of VA2 x: return x end;

Julian Kranz's avatar
Julian Kranz committed
1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211
  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
1212 1213 1214 1215 1216 1217 1218
val sem-movs x = do
  sz <- sizeof1 x.opnd1;
  src <- read sz x.opnd2;
  dst <- write sz x.opnd1;
  commit sz dst src
end

Julian Kranz's avatar
Julian Kranz committed
1219 1220 1221 1222 1223 1224 1225 1226 1227
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
1228
  commit sz-dst dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
1229 1230
end

Julian Kranz's avatar
Julian Kranz committed
1231
val sem-movzx x = do
Julian Kranz's avatar
Julian Kranz committed
1232 1233
  sz-dst <- sizeof1 x.opnd1;
  sz-src <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1234 1235 1236 1237 1238 1239
  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
1240
  commit sz-dst dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
1241 1242
end

Julian Kranz's avatar
Julian Kranz committed
1243
val sem-mul conv x = do
Julian Kranz's avatar
Julian Kranz committed
1244 1245 1246
  sz <- sizeof1 x.opnd1;

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

Julian Kranz's avatar
Julian Kranz committed
1249
  factor1 <- reads conv (sz + sz) x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1250 1251 1252 1253

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

Julian Kranz's avatar
Julian Kranz committed
1254 1255
  emit-mul-flags sz product;

Julian Kranz's avatar
Julian Kranz committed
1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267
  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
1268
  end
Julian Kranz's avatar
Julian Kranz committed
1269 1270 1271 1272
end

## N>>

Julian Kranz's avatar
Julian Kranz committed
1273 1274 1275 1276
val sem-nop x = do
  return void
end

Julian Kranz's avatar
Julian Kranz committed
1277 1278
## O>>

Julian Kranz's avatar
Julian Kranz committed
1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301
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
1302 1303
## P>>

Julian Kranz's avatar
Julian Kranz committed
1304
val ps-pop opnd-sz opnd = do
Julian Kranz's avatar
Julian Kranz committed
1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316
  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
1317
  sp-size <- sizeof1 (REG sp-reg);
Julian Kranz's avatar
Julian Kranz committed
1318

Julian Kranz's avatar
Julian Kranz committed
1319
  segmented-load opnd-sz opnd stack-addr-sz (var sp) (SEG_OVERRIDE SS);
Julian Kranz's avatar
Julian Kranz committed
1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337

  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
1338 1339
end

Julian Kranz's avatar
Julian Kranz committed
1340
val sem-pop x = do
Julian Kranz's avatar
Julian Kranz committed
1341
  dst <- write x.opnd-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
1342
  temp-dest <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1343 1344
  ps-pop x.opnd-sz temp-dest;
  commit x.opnd-sz dst (var temp-dest)
Julian Kranz's avatar
Julian Kranz committed
1345 1346
end

Julian Kranz's avatar
Julian Kranz committed
1347
val ps-push opnd-sz opnd = do
Julian Kranz's avatar
Julian Kranz committed
1348
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
1349
  stack-addr-sz <- runtime-stack-address-size;
Julian Kranz's avatar
Julian Kranz committed
1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360
  
  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
1361
  if mode64 then
Julian Kranz's avatar
Julian Kranz committed
1362 1363 1364 1365
    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
1366
  else
Julian Kranz's avatar
Julian Kranz committed
1367 1368 1369 1370
    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
1371 1372 1373
  ;

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

Julian Kranz's avatar
Julian Kranz committed
1375
  #store (address sp.size (segment-add (var sp) segment)) (lin opnd-sz opnd)
Julian Kranz's avatar
Julian Kranz committed
1376 1377
end

Julian Kranz's avatar
Julian Kranz committed
1378 1379 1380 1381 1382 1383 1384 1385
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
1386
         movzx x.opnd-sz temp src-size src
Julian Kranz's avatar
Julian Kranz committed
1387
       else
Julian Kranz's avatar
Julian Kranz committed
1388
         mov x.opnd-sz temp src
Julian Kranz's avatar
Julian Kranz committed
1389
   | MEM m:
Julian Kranz's avatar
Julian Kranz committed
1390
       mov x.opnd-sz temp src
Julian Kranz's avatar
Julian Kranz committed
1391
   | IMM8 i:
Julian Kranz's avatar
Julian Kranz committed
1392
       movsx x.opnd-sz temp src-size src
Julian Kranz's avatar
Julian Kranz committed
1393
   | IMM16 i:
Julian Kranz's avatar
Julian Kranz committed
1394
       mov x.opnd-sz temp src
Julian Kranz's avatar
Julian Kranz committed
1395
   | IMM32 i:
Julian Kranz's avatar
Julian Kranz committed
1396
       movsx x.opnd-sz temp src-size src
Julian Kranz's avatar
Julian Kranz committed
1397 1398
  end;

Julian Kranz's avatar
Julian Kranz committed
1399
  ps-push x.opnd-sz (var temp)
Julian Kranz's avatar
Julian Kranz committed
1400 1401
end

Julian Kranz's avatar
Julian Kranz committed
1402 1403 1404
## Q>>
## R>>

Julian Kranz's avatar
Julian Kranz committed
1405 1406
val sem-ret x =
  case x of
Julian Kranz's avatar
Julian Kranz committed
1407
     VA0 x: sem-ret-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1408 1409
   | VA1 x:
       do
Julian Kranz's avatar
Julian Kranz committed
1410
         release-from-stack x;
Julian Kranz's avatar
Julian Kranz committed
1411
	 sem-ret-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1412 1413 1414
       end
  end

Julian Kranz's avatar
Julian Kranz committed
1415 1416
val sem-ret-far x =
  case x of
Julian Kranz's avatar
Julian Kranz committed
1417
     VA0 x: sem-ret-far-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1418 1419 1420
   | VA1 x:
       do
         release-from-stack x;
Julian Kranz's avatar
Julian Kranz committed
1421
         sem-ret-far-without-operand x
Julian Kranz's avatar
Julian Kranz committed
1422 1423 1424
       end
  end

Julian Kranz's avatar
Julian Kranz committed
1425
val pop-ip opnd-sz = do
Julian Kranz's avatar
Julian Kranz committed
1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436
  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
1437
  return (address opnd-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
1438 1439
end

Julian Kranz's avatar
Julian Kranz committed
1440 1441
val sem-ret-without-operand x = do
  address <- pop-ip x.opnd-sz;
Julian Kranz's avatar
Julian Kranz committed
1442 1443 1444
  ret address
end

Julian Kranz's avatar
Julian Kranz committed
1445 1446
val sem-ret-far-without-operand x = do
  address <- pop-ip x.opnd-sz;
Julian Kranz's avatar
Julian Kranz committed
1447 1448

  temp-cs <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1449
  ps-pop x.opnd