x86-rreil-translator.ml 62.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
val runtime-opnd-sz x = do
Julian Kranz's avatar
Julian Kranz committed
6
  sz <- sizeof1 x;
Julian Kranz's avatar
Julian Kranz committed
7
  return sz
Julian Kranz's avatar
Julian Kranz committed
8 9
end

Julian Kranz's avatar
Julian Kranz committed
10 11 12 13 14
#Todo: Fix!!
val static-flow-opnd-sz x = do
  return 64
end

Julian Kranz's avatar
Julian Kranz committed
15 16 17 18
val runtime-stack-address-size = do
  return 32
end

Julian Kranz's avatar
Julian Kranz committed
19 20 21 22
val ip-get = do
  return (imm 0)
end

Julian Kranz's avatar
Julian Kranz committed
23 24 25 26 27 28 29 30 31 32
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
33
val sizeof2 dst/src1 src2 =
mb0's avatar
Up.  
mb0 committed
34 35 36 37 38 39 40 41 42 43
   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
44 45 46 47 48 49 50 51 52
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
53

Julian Kranz's avatar
Julian Kranz committed
54
val sizeof1 op =
mb0's avatar
Up.  
mb0 committed
55 56 57 58 59 60 61 62 63
   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
64 65 66 67
type signedness =
   Signed
 | Unsigned

Julian Kranz's avatar
Julian Kranz committed
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
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
84
in
Julian Kranz's avatar
Julian Kranz committed
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
  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
101
end
Julian Kranz's avatar
Julian Kranz committed
102

Julian Kranz's avatar
Julian Kranz committed
103 104 105 106 107
#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
108
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
109

Julian Kranz's avatar
Julian Kranz committed
110
  expanded <- expand Unsigned lin sz real-addr-sz;
Julian Kranz's avatar
Julian Kranz committed
111 112
  return (segment-add mode64 expanded segment)
end
Julian Kranz's avatar
Julian Kranz committed
113
val segmented-reg reg segment = segmented-lin (var reg) reg.size segment
Julian Kranz's avatar
Julian Kranz committed
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140

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

val segment segment = do
#  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
  return DS
Julian Kranz's avatar
Julian Kranz committed
141 142
end

Julian Kranz's avatar
Julian Kranz committed
143
val conv-with conv sz x =
mb0's avatar
Up.  
mb0 committed
144
   let
Julian Kranz's avatar
Julian Kranz committed
145 146 147 148 149
      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
150 151 152 153
      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
154

Julian Kranz's avatar
Julian Kranz committed
155
      val conv-sum conv sz x =
mb0's avatar
Up.  
mb0 committed
156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
         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
178
      val conv-mem x = conv-with Signed x.psz x.opnd
mb0's avatar
Up.  
mb0 committed
179 180 181 182 183 184
   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
185
       | REG x: conv-reg conv sz x
mb0's avatar
Up.  
mb0 committed
186 187 188
       | SUM x: conv-sum conv sz x
       | SCALE x: conv-scale conv sz x
       | MEM x:
Julian Kranz's avatar
Julian Kranz committed
189 190 191 192 193 194
           do 
	     t <- mktemp;
             address <- conv-mem x;
             segmented-load sz t x.psz address x.segment;
             return (var t)
           end
mb0's avatar
Up.  
mb0 committed
195 196 197
      end
   end

Julian Kranz's avatar
Julian Kranz committed
198
val read sz x = conv-with Unsigned sz x
Julian Kranz's avatar
Julian Kranz committed
199 200 201 202 203 204 205 206 207

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

Julian Kranz's avatar
Julian Kranz committed
261

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

Axel Simon's avatar
Axel Simon committed
292 293 294 295 296 297
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
298 299 300

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

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

Julian Kranz's avatar
Julian Kranz committed
352 353 354 355 356 357 358
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
359 360 361 362 363 364 365 366
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
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468
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
469
val undef-opnd opnd = do
Julian Kranz's avatar
Julian Kranz committed
470
  sz <- sizeof1 opnd;
Julian Kranz's avatar
Julian Kranz committed
471 472
  a <- write sz opnd;
  t <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
473
  commit sz a (var t)
Julian Kranz's avatar
Julian Kranz committed
474 475 476 477 478
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
479
   | MEM m: undef-opnd x.opnd1
Julian Kranz's avatar
Julian Kranz committed
480 481 482
  end
end

Julian Kranz's avatar
Julian Kranz committed
483
val sem-undef-arity0 = do
Julian Kranz's avatar
Julian Kranz committed
484
  return void
Julian Kranz's avatar
Julian Kranz committed
485 486 487
end

val sem-undef-arity1 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-arity2 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-arity3 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-arity4 x = do
Julian Kranz's avatar
Julian Kranz committed
500
  sem-undef-arity-ge1 x
Julian Kranz's avatar
Julian Kranz committed
501 502 503
end

val sem-undef-varity x = do
Julian Kranz's avatar
Julian Kranz committed
504 505 506 507 508 509
  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
510 511 512
end

val sem-undef-flow1 x = do
Julian Kranz's avatar
Julian Kranz committed
513
  return void
Julian Kranz's avatar
Julian Kranz committed
514 515
end

Julian Kranz's avatar
Julian Kranz committed
516
val emit-parity-flag r = do
Julian Kranz's avatar
Julian Kranz committed
517 518
  byte-size <- return 8;

Julian Kranz's avatar
Julian Kranz committed
519
  low-byte <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
520
  mov byte-size low-byte r;
Julian Kranz's avatar
Julian Kranz committed
521 522

  pf <- fPF;
Julian Kranz's avatar
Julian Kranz committed
523 524 525 526 527 528 529 530
  # 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
531 532
end

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

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

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

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

  # Hacker's Delight - Unsigned Add/Subtract
Julian Kranz's avatar
Julian Kranz committed
572
  _if (/d carry) _then do
Julian Kranz's avatar
Julian Kranz committed
573 574 575 576
    cmpleu sz cf sum s0
  end _else do
    cmpltu sz cf sum s0
  end;
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 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606
val emit-sub-sbb-flags sz difference minuend subtrahend carry = do
  eq <- fEQ;
  les <- fLES;
  leu <- fLEU;
  lts <- fLTS;
  ltu <- fLTU;
  sf <- fSF;
  ov <- fOF;
  cf <- fCF;
  z <- fZF;
  t1 <- mktemp;
  t2 <- mktemp;
  t3 <- mktemp;
  zer0 <- zero;

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

  # Hacker's Delight - Unsigned Add/Subtract
Julian Kranz's avatar
Julian Kranz committed
607
  _if (/d carry) _then do
Julian Kranz's avatar
Julian Kranz committed
608 609 610 611 612
    cmpleu sz cf minuend subtrahend
  end _else do
    cmpltu sz cf minuend subtrahend
  end;

Julian Kranz's avatar
Julian Kranz committed
613
  emit-parity-flag difference;
Julian Kranz's avatar
Julian Kranz committed
614 615
  emit-arithmetic-adjust-flag sz difference minuend subtrahend
end
mb0's avatar
Up.  
mb0 committed
616

Julian Kranz's avatar
Julian Kranz committed
617 618
## A>>

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

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

Julian Kranz's avatar
Julian Kranz committed
648 649
## B>>

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

Julian Kranz's avatar
Julian Kranz committed
684 685
## C>>

Julian Kranz's avatar
Julian Kranz committed
686
val sem-call x = do
Julian Kranz's avatar
Julian Kranz committed
687 688 689 690 691 692 693 694 695 696 697 698
  target-sz <- sizeof-flow x.opnd1;
  target <- read-flow target-sz x.opnd1;

  opnd-sz <- static-flow-opnd-sz x.opnd1;

  ip-sz <-
    if (opnd-sz === 64) then
      return 64
    else
      return 32
  ;
  
Julian Kranz's avatar
Julian Kranz committed
699
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
700 701 702
  
  temp-dest <- mktemp;
  temp-ip <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
703
  ip <- ip-get;
Julian Kranz's avatar
Julian Kranz committed
704
  if (near x.opnd1) then
Julian Kranz's avatar
Julian Kranz committed
705 706
    do
      if (relative x.opnd1) then
Julian Kranz's avatar
Julian Kranz committed
707 708
        do
          movsx ip-sz temp-dest target-sz target;
Julian Kranz's avatar
Julian Kranz committed
709 710 711 712 713 714
          add ip-sz temp-ip ip (var temp-dest);
          if (opnd-sz === 16) then
              mov (ip-sz - opnd-sz) (at-offset temp-ip opnd-sz) (imm 0)
          else
             return void
        end
Julian Kranz's avatar
Julian Kranz committed
715
      else
Julian Kranz's avatar
Julian Kranz committed
716 717 718 719
        movzx ip-sz temp-ip target-sz target
      ;
      ps-push ip-sz ip
    end
Julian Kranz's avatar
Julian Kranz committed
720
  else
Julian Kranz's avatar
Julian Kranz committed
721 722 723 724 725 726 727 728 729 730 731 732 733 734
    do
      movzx ip-sz temp-ip opnd-sz target;
      sec-reg <- return CS;
      sec-reg-sem <- return (semantic-register-of sec-reg);
      reg-size <- sizeof1 (REG sec-reg);
      sec-reg-extended <- mktemp;
      movzx opnd-sz sec-reg-extended reg-size (var sec-reg-sem);
      ps-push opnd-sz (var sec-reg-extended);
      
      ps-push ip-sz ip;

      mov target-sz temp-dest target;
      mov reg-size sec-reg-sem (var (at-offset temp-dest opnd-sz))
    end
Julian Kranz's avatar
Julian Kranz committed
735 736 737
  ;

  call (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
738 739
end

Julian Kranz's avatar
Julian Kranz committed
740 741 742 743 744
val sem-cdqe = do
  a <- return (semantic-register-of RAX);
  movsx 64 a 32 (var a)
end

Julian Kranz's avatar
Julian Kranz committed
745 746 747 748 749 750 751 752 753 754 755 756 757 758 759
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
760
val sem-cmovcc x cond = do
Julian Kranz's avatar
Julian Kranz committed
761 762 763
  sz <- sizeof1 x.opnd1;
  dst <- write sz x.opnd1;
  dst-read <- read sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
764

Julian Kranz's avatar
Julian Kranz committed
765
  src <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
766 767

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
768
  mov sz temp dst-read;
Julian Kranz's avatar
Julian Kranz committed
769 770

  _if cond _then
Julian Kranz's avatar
Julian Kranz committed
771
    mov sz temp src
Julian Kranz's avatar
Julian Kranz committed
772 773
  ;

Julian Kranz's avatar
Julian Kranz committed
774
  commit sz dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
775 776
end

Julian Kranz's avatar
Julian Kranz committed
777
val sem-cmp x = do
Julian Kranz's avatar
Julian Kranz committed
778
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
779 780 781 782 783
  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
784
  emit-sub-sbb-flags sz (var t) b c (imm 0)
Julian Kranz's avatar
Julian Kranz committed
785
end
mb0's avatar
Up.  
mb0 committed
786

Julian Kranz's avatar
Julian Kranz committed
787
val sem-cmps x = do
Julian Kranz's avatar
Julian Kranz committed
788 789
  opnd-sz <- return x.opnd-sz;
  src0 <- read opnd-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
790
  src1-sz <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
791
  src1 <- read opnd-sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
792 793

  temp <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
794 795
  sub opnd-sz temp src0 src1;
  emit-sub-sbb-flags opnd-sz (var temp) src0 src1 (imm 0);
Julian Kranz's avatar
Julian Kranz committed
796 797

  amount <-
Julian Kranz's avatar
Julian Kranz committed
798
    case opnd-sz of
Julian Kranz's avatar
Julian Kranz committed
799 800 801 802 803 804 805
       8: return 1
     | 16: return 2
     | 32: return 4
     | 64: return 8
    end
  ;

Julian Kranz's avatar
Julian Kranz committed
806 807 808 809
  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
810 811
  df <- fDF;
  _if (/not (var df)) _then do
Julian Kranz's avatar
Julian Kranz committed
812 813
    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
814
  end _else do
Julian Kranz's avatar
Julian Kranz committed
815 816
    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
817 818
  end

Julian Kranz's avatar
Julian Kranz committed
819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846
#  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
847
end
Julian Kranz's avatar
Julian Kranz committed
848 849 850 851
#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
852 853


Julian Kranz's avatar
Julian Kranz committed
854 855 856 857
val sem-hlt = do
  return void
end

Julian Kranz's avatar
Julian Kranz committed
858 859 860 861 862
val sem-jcc x cond = do
  target-sz <- sizeof-flow x.opnd1;
  target <- read-flow target-sz x.opnd1;

  #Todo: fix
Julian Kranz's avatar
Julian Kranz committed
863
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885
  opnd-sz <-
    if mode64 then
      return 64
    else
      return 32
  ;

  ip-sz <-
    if (opnd-sz === 64) then
      return 64
    else
      return 32
  ;
  
  ip <- ip-get;

  target-ext <- mktemp;
  movsx ip-sz target-ext target-sz target;

  temp-ip <- mktemp;
  add ip-sz temp-ip (var target-ext) ip;

Julian Kranz's avatar
Julian Kranz committed
886 887
  cond <- cond;
  cbranch cond (address ip-sz (var temp-ip)) (address ip-sz ip)
Julian Kranz's avatar
Julian Kranz committed
888 889 890 891 892 893
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
894 895
end

Julian Kranz's avatar
Julian Kranz committed
896 897 898 899
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
900
val sem-jmp x = do
Julian Kranz's avatar
Julian Kranz committed
901
  target-sz <- sizeof-flow x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
902
  #Todo: Richtig Größe an der richtigen Stelle (unten) [=> auch bei call/jcc?]
Julian Kranz's avatar
Julian Kranz committed
903
  target <- read-flow target-sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
904 905
 
  #Todo: Jetzt in Instruktion => x.opndsz
Julian Kranz's avatar
Julian Kranz committed
906 907
  opnd-sz <- static-flow-opnd-sz x.opnd1;
  
Julian Kranz's avatar
Julian Kranz committed
908
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928

  ip-sz <-
    if mode64 then
      return 64
    else
      return 32
  ;

  temp-ip <- mktemp;
  if (near x.opnd1) then
    do
      if (relative x.opnd1) then
        do
          ip <- ip-get;
          add ip-sz temp-ip ip target
        end
      else
        mov ip-sz temp-ip target
      ;
      if (opnd-sz === 16) then
Julian Kranz's avatar
Julian Kranz committed
929 930
        #andb ip-sz temp-ip (var temp-ip) (imm 0xffff)
	mov (ip-sz - opnd-sz) (at-offset temp-ip opnd-sz) (imm 0)
Julian Kranz's avatar
Julian Kranz committed
931 932 933
      else
        return void
    end
Julian Kranz's avatar
Julian Kranz committed
934 935 936 937
  else if (not mode64) then
    do
      mov ip-sz temp-ip target;
      if (opnd-sz === 16) then
Julian Kranz's avatar
Julian Kranz committed
938 939
        #andb ip-sz temp-ip (var temp-ip) (imm 0xffff)
	mov (ip-sz - opnd-sz) (at-offset temp-ip opnd-sz) (imm 0)
Julian Kranz's avatar
Julian Kranz committed
940 941 942 943 944 945 946 947 948 949 950 951
      else
        return void
      ;
      temp-target <- mktemp;
      mov target-sz temp-target target;
      reg <- return CS;
      reg-sem <- return (semantic-register-of reg);
      reg-size <- sizeof1 (REG reg);
      mov reg-size reg-sem (var (at-offset temp-target ip-sz));
      
      mov ip-sz temp-ip target
    end
Julian Kranz's avatar
Julian Kranz committed
952 953 954 955
  else
    return void
  ;

Julian Kranz's avatar
Julian Kranz committed
956
  jump (address ip-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
957 958
end

Julian Kranz's avatar
Julian Kranz committed
959
val sem-lea x = do
Julian Kranz's avatar
Julian Kranz committed
960
  opnd-sz <- sizeof1 x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
961 962 963 964 965 966 967 968 969 970 971 972 973 974 975
  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
976
val sem-mov x = do
Julian Kranz's avatar
Julian Kranz committed
977
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
978
  a <- write sz x.opnd1;
Julian Kranz's avatar
Julian Kranz committed
979
  b <- read sz x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
980 981
  commit sz a b
end
mb0's avatar
Up.  
mb0 committed
982

Julian Kranz's avatar
Julian Kranz committed
983
val sem-movap x = do
Julian Kranz's avatar
Julian Kranz committed
984 985 986 987 988 989 990 991 992 993
  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
994 995 996
val sem-vmovap x = do
  x <- case x of VA2 x: return x end;

Julian Kranz's avatar
Julian Kranz committed
997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014
  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
1015 1016 1017 1018 1019 1020 1021 1022 1023
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
1024
  commit sz-dst dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
1025 1026
end

Julian Kranz's avatar
Julian Kranz committed
1027
val sem-movzx x = do
Julian Kranz's avatar
Julian Kranz committed
1028 1029
  sz-dst <- sizeof1 x.opnd1;
  sz-src <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1030 1031 1032 1033 1034 1035
  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
1036
  commit sz-dst dst (var temp)
Julian Kranz's avatar
Julian Kranz committed
1037 1038
end

Julian Kranz's avatar
Julian Kranz committed
1039 1040 1041 1042
val sem-nop x = do
  return void
end

Julian Kranz's avatar
Julian Kranz committed
1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065
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
1066
val ps-pop opnd-sz opnd = do
Julian Kranz's avatar
Julian Kranz committed
1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078
  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
1079
  sp-size <- sizeof1 (REG sp-reg);
Julian Kranz's avatar
Julian Kranz committed
1080

Julian Kranz's avatar
Julian Kranz committed
1081
  segmented-load opnd-sz opnd stack-addr-sz (var sp) (SEG_OVERRIDE SS);
Julian Kranz's avatar
Julian Kranz committed
1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099

  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
1100 1101
end

Julian Kranz's avatar
Julian Kranz committed
1102 1103 1104 1105 1106 1107 1108 1109
val sem-pop x = do
  opnd-sz <- runtime-opnd-sz x.opnd1;
  dst <- write opnd-sz x.opnd1;
  temp-dest <- mktemp;
  ps-pop opnd-sz temp-dest;
  commit opnd-sz dst (var temp-dest)
end

Julian Kranz's avatar
Julian Kranz committed
1110
val ps-push opnd-sz opnd = do
Julian Kranz's avatar
Julian Kranz committed
1111
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
1112
  stack-addr-sz <- runtime-stack-address-size;
Julian Kranz's avatar
Julian Kranz committed
1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123
  
  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
1124
  if mode64 then
Julian Kranz's avatar
Julian Kranz committed
1125 1126 1127 1128
    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
1129
  else
Julian Kranz's avatar
Julian Kranz committed
1130 1131 1132 1133
    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
1134 1135 1136
  ;

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

Julian Kranz's avatar
Julian Kranz committed
1138
  #store (address sp.size (segment-add (var sp) segment)) (lin opnd-sz opnd)
Julian Kranz's avatar
Julian Kranz committed
1139 1140
end

Julian Kranz's avatar
Julian Kranz committed
1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163
val sem-push x = do
  opnd-sz <- runtime-opnd-sz x.opnd1;
       
  src-size <- sizeof1 x.opnd1;
  src <- read src-size x.opnd1;

  temp <- mktemp;
  case x.opnd1 of
     REG r: 
       if segment-register? r then
         movzx opnd-sz temp src-size src
       else
         mov opnd-sz temp src
   | MEM m:
       mov opnd-sz temp src
   | IMM8 i:
       movsx opnd-sz temp src-size src
   | IMM16 i:
       mov opnd-sz temp src
   | IMM32 i:
       movsx opnd-sz temp src-size src
  end;

Julian Kranz's avatar
Julian Kranz committed
1164
  ps-push opnd-sz (var temp)
Julian Kranz's avatar
Julian Kranz committed
1165 1166
end

Julian Kranz's avatar
Julian Kranz committed
1167 1168 1169 1170 1171
val sem-ret x =
  case x of
     VA0: sem-ret-without-operand
   | VA1 x:
       do
Julian Kranz's avatar
Julian Kranz committed
1172
         release-from-stack x;
Julian Kranz's avatar
Julian Kranz committed
1173 1174 1175 1176
	 sem-ret-without-operand
       end
  end

Julian Kranz's avatar
Julian Kranz committed
1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187
val sem-ret-far x =
  case x of
     VA0: sem-ret-far-without-operand
   | VA1 x:
       do
         release-from-stack x;
         sem-ret-far-without-operand
       end
  end

val pop-ip = do
Julian Kranz's avatar
Julian Kranz committed
1188
  #Todo: fix
Julian Kranz's avatar
Julian Kranz committed
1189
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207
  opnd-sz <-
    if mode64 then
      return 64
    else
      return 32
  ;

  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
1208
  return (address opnd-sz (var temp-ip))
Julian Kranz's avatar
Julian Kranz committed
1209 1210
end

Julian Kranz's avatar
Julian Kranz committed
1211 1212 1213 1214 1215 1216 1217 1218 1219
val sem-ret-without-operand = do
  address <- pop-ip;
  ret address
end

val sem-ret-far-without-operand = do
  address <- pop-ip;

  #Todo: fix
Julian Kranz's avatar
Julian Kranz committed
1220
  mode64 <- mode64?;
Julian Kranz's avatar
Julian Kranz committed
1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240
  opnd-sz <-
    if mode64 then
      return 64
    else
      return 32
  ;

  temp-cs <- mktemp;
  ps-pop opnd-sz temp-cs;
  
  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
1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253
  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
1254

Julian Kranz's avatar
Julian Kranz committed
1255 1256 1257
  sp <- return (semantic-register-of sp-reg);
  sp-size <- sizeof1 (REG sp-reg);

Julian Kranz's avatar
Julian Kranz committed
1258 1259
  src-ext <- mktemp;
  movzx sp-size src-ext x-sz src;
Julian Kranz's avatar
Julian Kranz committed
1260

Julian Kranz's avatar
Julian Kranz committed
1261
  add sp-size sp (var sp) (var src-ext)
Julian Kranz's avatar
Julian Kranz committed
1262 1263
end

Julian Kranz's avatar
Julian Kranz committed
1264
val sem-sal-shl x = do
Julian Kranz's avatar
Julian Kranz committed
1265 1266
  sz <- sizeof1 x.opnd1;
  szOp2 <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1267 1268 1269
  dst <- write sz x.opnd1;
  src <- read sz x.opnd1;
  count <- read szOp2 x.opnd2;
mb0's avatar
Up.  
mb0 committed
1270

Julian Kranz's avatar
Julian Kranz committed
1271 1272 1273 1274 1275 1276 1277 1278 1279
  #count-mask <- const
  #   (case sz of
  #       8: 31
  #     | 16: 31
  #     | 32: 31
  #     | 64: 63
  #    end);
  #temp-count <- mktemp;
  #andb sz temp-count count count-mask;
Julian Kranz's avatar
Julian Kranz committed
1280
 
Julian Kranz's avatar
Julian Kranz committed
1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292
  real-shift-count-size <-
    case sz of
       8: return 5
     | 16: return 5
     | 32: return 5
     | 64: return 6
    end
  ;
  temp-count <- mktemp;
  mov real-shift-count-size temp-count count;
  mov (sz - real-shift-count-size) (at-offset temp-count real-shift-count-size) (imm 0);

Julian Kranz's avatar
Julian Kranz committed
1293
  tdst <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1294 1295 1296
  cf <- fCF;

  _if (/gtu sz (var temp-count) (imm 0)) _then do
Julian Kranz's avatar
Julian Kranz committed
1297
    shl sz tdst src (var temp-count);
Julian Kranz's avatar
Julian Kranz committed
1298

Julian Kranz's avatar
Julian Kranz committed
1299 1300 1301 1302
    temp-c <- mktemp;
    sub sz temp-c (imm sz) (var temp-count);
    shr sz temp-c src (var temp-c);
    mov 1 cf (var temp-c)
Julian Kranz's avatar
Julian Kranz committed
1303
  end;
Julian Kranz's avatar
Julian Kranz committed
1304

Julian Kranz's avatar
Julian Kranz committed
1305
  ov <- fOF;
Julian Kranz's avatar
Julian Kranz committed
1306 1307 1308
  _if (/eq sz (var temp-count) (imm 1)) _then
    xorb 1 ov (var (at-offset tdst (sz - 1))) (var cf)
  _else (_if (/neq sz (var temp-count) (imm 0)) _then
Julian Kranz's avatar
Julian Kranz committed
1309 1310
    undef 1 ov)
  ;
Julian Kranz's avatar
Julian Kranz committed
1311

Julian Kranz's avatar
Julian Kranz committed
1312 1313 1314 1315 1316 1317
  sf <- fSF;
  cmplts sz sf (var tdst) (imm 0);

  zf <- fZF;
  cmpeq sz zf (var tdst) (imm 0);

Julian Kranz's avatar
Julian Kranz committed
1318
  emit-parity-flag (var tdst);
Julian Kranz's avatar
Julian Kranz committed
1319 1320

  commit sz dst (var tdst)
Julian Kranz's avatar
Julian Kranz committed
1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364

#  # dst => a, src => b, amount => c
#  ## Temporary variables:
#  t1 <- mktemp;
#  t2 <- mktemp;
#  cnt <- mktemp;
#  cntIsZero <- mktemp;
#  cntIsOne <- mktemp;
#  af <- fAF;
#  ov <- fOF;
#  cf <- fCF;
#  eq <- fEQ;
#  mask <- const
#     (case sz of
#         8: 31
#       | 16: 31
#       | 32: 31
#       | 64: 63
#      end);
#  zer0 <- const 0;
#  one <- const 1;
#
#  ## Instruction semantics:
#  setflag <- mklabel;
#  exit <- mklabel;
#  nop <- mklabel;
#  convert sz cnt szOp2 c;
#  andb sz cnt (var cnt) mask;
#  cmpeq sz cntIsZero (var cnt) zer0;
#  ifgotolabel (var cntIsZero) nop;
#  shl sz t1 b (/SUB (var cnt) one);
#  mov 1 cf (var (t1 /+ (sz - 1)));
#  shl sz t2 b (var cnt);
#  cmpeq sz cntIsOne (var cnt) one;
#  ifgotolabel (var cntIsOne) setflag;
#  undef 1 ov;
#  gotolabel exit;
#  label setflag;
#  xorb 1 ov (var cf) (var (t2 /+ (sz - 1)));
#  label exit;
#  undef 1 af;
#  commit sz a (var t2);
#  label nop;
#  cmpeq sz eq b zer0
Julian Kranz's avatar
Julian Kranz committed
1365 1366 1367
end

val sem-sar x = do
Julian Kranz's avatar
Julian Kranz committed
1368 1369
  sz <- sizeof1 x.opnd1;
  szOp2 <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1370 1371 1372 1373
  dst <- write sz x.opnd1;
  src <- read sz x.opnd1;
  count <- read szOp2 x.opnd2;

Julian Kranz's avatar
Julian Kranz committed
1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391
  #count-mask <- const
  #   (case sz of
  #       8: 31
  #     | 16: 31
  #     | 32: 31
  #     | 64: 63
  #    end);
  #temp-count <- mktemp;
  #andb sz temp-count count count-mask;
 
  real-shift-count-size <-
    case sz of
       8: return 5
     | 16: return 5
     | 32: return 5
     | 64: return 6
    end
  ;
Julian Kranz's avatar
Julian Kranz committed
1392
  temp-count <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1393 1394
  mov real-shift-count-size temp-count count;
  mov (sz - real-shift-count-size) (at-offset temp-count real-shift-count-size) (imm 0);
Julian Kranz's avatar
Julian Kranz committed
1395 1396

  tdst <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1397
  cf <- fCF;
Julian Kranz's avatar
Julian Kranz committed
1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420

  _if (/gtu sz (var temp-count) (imm 0)) _then do
    sub sz temp-count (var temp-count) (imm 1);
    shrs sz tdst src (var temp-count);

    mov 1 cf (var tdst);

    shrs sz tdst (var tdst) (imm 1)
  end;
 
  ov <- fOF;
  _if (/eq sz (var temp-count) (imm 1)) _then
    mov 1 ov (imm 0)
  _else (_if (/neq sz (var temp-count) (imm 0)) _then
    undef 1 ov)
  ;

  sf <- fSF;
  cmplts sz sf (var tdst) (imm 0);

  zf <- fZF;
  cmpeq sz zf (var tdst) (imm 0);

Julian Kranz's avatar
Julian Kranz committed
1421
  emit-parity-flag (var tdst);
Julian Kranz's avatar
Julian Kranz committed
1422 1423 1424 1425

  commit sz dst (var tdst)
end

Julian Kranz's avatar
Julian Kranz committed
1426
val sem-sbb x = do
Julian Kranz's avatar
Julian Kranz committed
1427
  sz <- sizeof2 x.opnd1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441
  difference <- write sz x.opnd1;
  minuend <- read sz x.opnd1;
  subtrahend <- read sz x.opnd2;

  t <- mktemp;
  cf <- fCF;
  movzx sz t 1 (var cf);
  add sz t (var t) subtrahend;
  sub sz t minuend subtrahend;

  emit-sub-sbb-flags sz (var t) minuend subtrahend (var cf);
  commit sz difference (var t)
end

Julian Kranz's avatar
Julian Kranz committed
1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452
val sem-setcc x cond = do
  dst-sz <- sizeof1 x.opnd1;
  dst <- write dst-sz x.opnd1;

  cond <- cond;
  temp <- mktemp;
  movzx dst-sz temp 1 cond;

  commit dst-sz dst (var temp)
end

Julian Kranz's avatar
Julian Kranz committed
1453
val sem-shr x = do
Julian Kranz's avatar
Julian Kranz committed
1454 1455
  sz <- sizeof1 x.opnd1;
  szOp2 <- sizeof1 x.opnd2;
Julian Kranz's avatar
Julian Kranz committed
1456 1457 1458 1459
  dst <- write sz x.opnd1;
  src <- read sz x.opnd1;
  count <- read szOp2 x.opnd2;

Julian Kranz's avatar
Julian Kranz committed
1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477
  #count-mask <- const
  #   (case sz of
  #       8: 31
  #     | 16: 31
  #     | 32: 31
  #     | 64: 63
  #    end);
  #temp-count <- mktemp;
  #andb sz temp-count count count-mask;

  real-shift-count-size <-
    case sz of
       8: return 5
     | 16: return 5
     | 32: return 5
     | 64: return 6
    end
  ;
Julian Kranz's avatar
Julian Kranz committed
1478
  temp-count <- mktemp;
Julian Kranz's avatar
Julian Kranz committed
1479 1480
  mov real-shift-count-size temp-count count;
  mov (sz - real-shift-count-size) (at-offset temp-count real-shift-count-size) (imm 0);
Julian Kranz's avatar
Julian Kranz committed
1481

Julian Kranz's avatar
Julian Kranz committed
1482 1483 1484 1485
  tdst <- mktemp;
  cf <- fCF;

  _if (/gtu sz (var temp-count) (imm 0)) _then do
Julian Kranz's avatar
Julian Kranz committed
1486 1487
    sub sz temp-count (var temp-count) (imm 1);
    shr sz tdst src (var temp-count);
Julian Kranz's avatar
Julian Kranz committed
1488

Julian Kranz's avatar
Julian Kranz committed
1489
    mov 1 cf (var tdst);
Julian Kranz's avatar
Julian Kranz committed
1490

Julian Kranz's avatar
Julian Kranz committed
1491 1492 1493
    shr sz tdst (var tdst) (imm 1)
  end;
 
Julian Kranz's avatar
Julian Kranz committed
1494
  ov <- fOF;
Julian Kranz's avatar
Julian Kranz committed
1495 1496 1497