1 (* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
9 functor x86Simplify(S: X86_SIMPLIFY_STRUCTS): X86_SIMPLIFY =
15 val tracer = x86.tracer
16 val tracerTop = x86.tracerTop
18 structure PeepholeBlock =
21 = Peephole(type entry_type = Entry.t
22 type profileLabel_type = ProfileLabel.t option
23 type statement_type = Assembly.t
24 type transfer_type = Transfer.t
25 datatype block = datatype Block.t)
28 fun make_callback_msg name
32 val callback = fn true => (Int.inc count; Int.inc total)
33 | false => Int.inc total
34 val msg = fn () => Control.messageStr
37 ": ", Int.toString (!count),
38 " / ", Int.toString (!total)])
43 val isComment : statement_type -> bool
44 = fn Assembly.Comment _
49 val isInstructionMOV : statement_type -> bool
50 = fn Assembly.Instruction (Instruction.MOV _)
54 val isInstructionBinALMD : statement_type -> bool
55 = fn Assembly.Instruction (Instruction.BinAL _)
57 | Assembly.Instruction (Instruction.pMD _)
59 | Assembly.Instruction (Instruction.IMUL2 _)
63 val template : template
64 = {start = EmptyOrNonEmpty,
65 statements = [One isInstructionMOV,
67 One isInstructionBinALMD],
68 finish = EmptyOrNonEmpty,
69 transfer = fn _ => true}
71 val rewriter : rewriter
76 [[Assembly.Instruction (Instruction.MOV
81 [Assembly.Instruction (Instruction.BinAL
88 => if Size.eq(size1, size2) andalso
89 Operand.eq(dst1, dst2) andalso
90 Operand.eq(src1, src2)
93 = (Assembly.instruction_mov
97 (Assembly.instruction_binal
106 List.concat [comments,
112 profileLabel = profileLabel,
113 statements = statements,
114 transfer = transfer})
121 [[Assembly.Instruction (Instruction.MOV
126 [Assembly.Instruction (Instruction.pMD
133 => if Size.eq(size1, size2) andalso
134 Operand.eq(dst1, dst2) andalso
135 Operand.eq(src1, src2)
138 = (Assembly.instruction_mov
142 (Assembly.instruction_pmd
151 List.concat [comments,
157 profileLabel = profileLabel,
158 statements = statements,
159 transfer = transfer})
166 [[Assembly.Instruction (Instruction.MOV
171 [Assembly.Instruction (Instruction.IMUL2
177 => if Size.eq(size1, size2) andalso
178 Operand.eq(dst1, dst2) andalso
179 Operand.eq(src1, src2)
182 = (Assembly.instruction_mov
186 (Assembly.instruction_imul2
194 List.concat [comments,
200 profileLabel = profileLabel,
201 statements = statements,
202 transfer = transfer})
205 | _ => Error.bug "x86Simplify.PeepholeBlock: elimBinALMDDouble"
207 val (callback,elimBinALMDDouble_msg)
208 = make_callback_msg "elimBinALMDDouble"
210 val elimBinALMDDouble : optimization
211 = {template = template,
214 val elimBinALMDDouble_msg = elimBinALMDDouble_msg
218 val isInstructionFMOV : statement_type -> bool
219 = fn Assembly.Instruction (Instruction.pFMOV _)
223 val isInstructionFBinA : statement_type -> bool
224 = fn Assembly.Instruction (Instruction.pFBinA _)
226 | Assembly.Instruction (Instruction.pFBinAS _)
228 | Assembly.Instruction (Instruction.pFBinASP _)
232 val template : template
233 = {start = EmptyOrNonEmpty,
234 statements = [One isInstructionFMOV,
236 One isInstructionFBinA],
237 finish = EmptyOrNonEmpty,
238 transfer = fn _ => true}
240 val rewriter : rewriter
245 [[Assembly.Instruction (Instruction.pFMOV
250 [Assembly.Instruction (Instruction.pFBinA
257 => if Size.eq(size1, size2) andalso
258 Operand.eq(dst1, dst2) andalso
259 Operand.eq(src1, src2)
262 = (Assembly.instruction_pfmov
266 (Assembly.instruction_pfbina
275 List.concat [comments,
281 profileLabel = profileLabel,
282 statements = statements,
283 transfer = transfer})
290 [[Assembly.Instruction (Instruction.pFMOV
295 [Assembly.Instruction (Instruction.pFBinAS
302 => if Size.eq(size1, size2) andalso
303 Operand.eq(dst1, dst2) andalso
304 Operand.eq(src1, src2)
307 = (Assembly.instruction_pfmov
311 (Assembly.instruction_pfbinas
320 List.concat [comments,
326 profileLabel = profileLabel,
327 statements = statements,
328 transfer = transfer})
335 [[Assembly.Instruction (Instruction.pFMOV
340 [Assembly.Instruction (Instruction.pFBinASP
347 => if Size.eq(size1, size2) andalso
348 Operand.eq(dst1, dst2) andalso
349 Operand.eq(src1, src2)
352 = (Assembly.instruction_pfmov
356 (Assembly.instruction_pfbinasp
365 List.concat [comments,
371 profileLabel = profileLabel,
372 statements = statements,
373 transfer = transfer})
376 | _ => Error.bug "x86Simplify.PeepholeBlock: elimFltBinADouble"
378 val (callback,elimFltBinADouble_msg)
379 = make_callback_msg "elimFltBinADouble"
381 val elimFltBinADouble : optimization
382 = {template = template,
385 val elimFltBinADouble_msg = elimFltBinADouble_msg
389 val isInstructionMOV_srcImmediate : statement_type -> bool
390 = fn Assembly.Instruction (Instruction.MOV
391 {src = Operand.Immediate _,
396 val isInstructionBinALMD_operCommute : statement_type -> bool
397 = fn Assembly.Instruction (Instruction.BinAL
398 {oper, src, dst, ...})
399 => ((oper = Instruction.ADD)
401 (oper = Instruction.ADC)
403 (oper = Instruction.AND)
405 (oper = Instruction.OR)
407 (oper = Instruction.XOR))
409 (case (Operand.deMemloc src,
410 Operand.deMemloc dst)
411 of (SOME src, SOME dst)
413 (src::(MemLoc.utilized src),
414 fn memloc => MemLoc.mayAlias(memloc, dst)))
416 | Assembly.Instruction (Instruction.pMD
417 {oper, src, dst, ...})
418 => ((oper = Instruction.IMUL)
420 (oper = Instruction.MUL))
422 (case (Operand.deMemloc src,
423 Operand.deMemloc dst)
424 of (SOME src, SOME dst)
426 (src::(MemLoc.utilized src),
427 fn memloc => MemLoc.mayAlias(memloc, dst)))
429 | Assembly.Instruction (Instruction.IMUL2
431 => (case (Operand.deMemloc src,
432 Operand.deMemloc dst)
433 of (SOME src, SOME dst)
435 (src::(MemLoc.utilized src),
436 fn memloc => MemLoc.mayAlias(memloc, dst)))
440 val template : template
441 = {start = EmptyOrNonEmpty,
442 statements = [One isInstructionMOV_srcImmediate,
444 One isInstructionBinALMD_operCommute],
445 finish = EmptyOrNonEmpty,
446 transfer = fn _ => true}
448 val rewriter : rewriter
453 [[Assembly.Instruction (Instruction.MOV
458 [Assembly.Instruction (Instruction.BinAL
465 => if Size.eq(size1, size2) andalso
466 Operand.eq(dst1, dst2)
467 then case (src1, src2)
468 of (Operand.Immediate _, Operand.Immediate _)
470 | (Operand.Immediate _, _)
473 = (Assembly.instruction_mov
477 (Assembly.instruction_binal
486 List.concat [comments,
492 profileLabel = profileLabel,
493 statements = statements,
494 transfer = transfer})
502 [[Assembly.Instruction (Instruction.MOV
507 [Assembly.Instruction (Instruction.pMD
514 => if Size.eq(size1, size2) andalso
515 Operand.eq(dst1, dst2)
516 then case (src1, src2)
517 of (Operand.Immediate _, Operand.Immediate _)
519 | (Operand.Immediate _, _)
522 = (Assembly.instruction_mov
526 (Assembly.instruction_pmd
535 List.concat [comments,
541 profileLabel = profileLabel,
542 statements = statements,
543 transfer = transfer})
551 [[Assembly.Instruction (Instruction.MOV
556 [Assembly.Instruction (Instruction.IMUL2
562 => if Size.eq(size1, size2) andalso
563 Operand.eq(dst1, dst2)
564 then case (src1, src2)
565 of (Operand.Immediate _, Operand.Immediate _)
567 | (Operand.Immediate _, _)
570 = (Assembly.instruction_mov
574 (Assembly.instruction_imul2
582 List.concat [comments,
588 profileLabel = profileLabel,
589 statements = statements,
590 transfer = transfer})
594 | _ => Error.bug "x86Simplify.PeepholeBlock: commuteBinALMD"
596 val (callback,commuteBinALMD_msg)
597 = make_callback_msg "commuteBinALMD"
599 val commuteBinALMD : optimization
600 = {template = template,
603 val commuteBinALMD_msg = commuteBinALMD_msg
608 = fn Immediate.Word w => if WordX.isOne w
610 else if WordX.isNegOne w
615 val isInstructionADDorSUB_srcImmediate1 : statement_type -> bool
616 = fn Assembly.Instruction (Instruction.BinAL
618 src = Operand.Immediate immediate,
621 of Instruction.ADD => true
622 | Instruction.SUB => true
625 isSome (getImmediate1 (Immediate.destruct immediate))
628 val template : template
629 = {start = EmptyOrNonEmpty,
630 statements = [One isInstructionADDorSUB_srcImmediate1],
631 finish = EmptyOrNonEmpty,
632 transfer = fn _ => true}
634 val rewriter : rewriter
639 [[Assembly.Instruction (Instruction.BinAL
641 src = Operand.Immediate immediate,
646 => if (case List.fold
647 (finish, (false, false), fn (asm, (b, b')) =>
649 of Assembly.Comment _ => (b, b')
650 | Assembly.Instruction
652 {oper = Instruction.ADC, ...})
653 => (true, if b then b' else true)
654 | Assembly.Instruction
656 {oper = Instruction.SBB, ...})
657 => (true, if b then b' else true)
658 | Assembly.Instruction
660 {condition = Instruction.C, ...})
661 => (true, if b then b' else true)
662 | Assembly.Instruction
664 {condition = Instruction.NC, ...})
665 => (true, if b then b' else true)
668 | (false, _) => (case transfer
670 {condition = Instruction.C, ...} => true
672 {condition = Instruction.NC, ...} => true
678 = case (oper, getImmediate1 (Immediate.destruct immediate))
679 of (Instruction.ADD, SOME false) => Instruction.INC
680 | (Instruction.ADD, SOME true ) => Instruction.DEC
681 | (Instruction.SUB, SOME false) => Instruction.DEC
682 | (Instruction.SUB, SOME true ) => Instruction.INC
683 | _ => Error.bug "x86Simplify.PeeholeBlock: elimAddSub1:oper"
686 = (Assembly.instruction_unal
699 profileLabel = profileLabel,
700 statements = statements,
701 transfer = transfer})
703 | _ => Error.bug "x86Simplify.PeeholeBlock: elimAddSub1"
705 val (callback,elimAddSub1_msg)
706 = make_callback_msg "elimAddSub1"
708 val elimAddSub1: optimization
709 = {template = template,
712 val elimAddSub1_msg = elimAddSub1_msg
717 = fn (w : WordX.t, i : int) =>
718 if WordX.isZero w then NONE
719 else if WordX.isOne (WordX.andb (w, WordX.one (WordX.size w)))
720 then if WordX.isOne w
722 else if WordX.isNegOne w
725 else log2' (WordX.rshift (w, WordX.one (WordX.size w), {signed = true}), i + 1)
726 fun log2 w = log2' (w, 0 : int)
728 = MemLoc.imm {base = Immediate.label (Label.fromString "divTemp"),
729 index = Immediate.zero,
732 class = MemLoc.Class.Temp}
735 = fn Immediate.Word w => isSome (log2 w)
739 = fn Immediate.Word w => log2 w
742 val isInstructionMULorDIV_srcImmediatePow2 : statement_type -> bool
743 = fn Assembly.Instruction (Instruction.pMD
745 src = Operand.Immediate immediate,
748 of Instruction.IMUL => true
749 | Instruction.MUL => true
750 | Instruction.IDIV => true
751 | Instruction.DIV => true
754 isImmediatePow2 (Immediate.destruct immediate)
755 | Assembly.Instruction (Instruction.IMUL2
756 {src = Operand.Immediate immediate,
758 => isImmediatePow2 (Immediate.destruct immediate)
761 val template : template
762 = {start = EmptyOrNonEmpty,
764 = [One isInstructionMULorDIV_srcImmediatePow2,
766 finish = EmptyOrNonEmpty,
767 transfer = fn _ => true}
769 val rewriter : rewriter
774 [[Assembly.Instruction (Instruction.pMD
775 {oper = Instruction.IMUL,
776 src = Operand.Immediate immediate,
781 transfer as Transfer.Iff {condition,
784 => (case getImmediateLog2 (Immediate.destruct immediate)
785 of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
791 => Transfer.Goto {target = falsee}
793 => Transfer.Goto {target = truee}
794 | _ => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:transfer"
803 profileLabel = profileLabel,
804 statements = statements,
805 transfer = transfer})
812 (Assembly.instruction_unal
813 {oper = Instruction.NEG,
821 profileLabel = profileLabel,
822 statements = statements,
823 transfer = transfer})
832 then (Assembly.instruction_unal
833 {oper = Instruction.NEG,
838 ((Assembly.instruction_binal
839 {oper = Instruction.ADD,
848 profileLabel = profileLabel,
849 statements = statements,
850 transfer = transfer})
857 [[Assembly.Instruction (Instruction.pMD
858 {oper = Instruction.IMUL,
859 src = Operand.Immediate immediate,
865 => (case getImmediateLog2 (Immediate.destruct immediate)
866 of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
870 profileLabel = profileLabel,
871 statements = List.fold(start,
872 List.concat [comments, finish],
874 transfer = transfer})
878 = (Assembly.instruction_unal
879 {oper = Instruction.NEG,
882 (List.concat [comments, finish])
891 profileLabel = profileLabel,
892 statements = statements,
893 transfer = transfer})
902 then (Assembly.instruction_unal
903 {oper = Instruction.NEG,
908 ((Assembly.instruction_binal
909 {oper = Instruction.ADD,
913 (List.concat [comments, finish])),
918 profileLabel = profileLabel,
919 statements = statements,
920 transfer = transfer})
923 => if i < (8 * Size.toBytes size)
927 => (Assembly.instruction_sral
928 {oper = Instruction.SAL,
929 count = Operand.immediate_int i,
933 then (Assembly.instruction_unal
934 {oper = Instruction.NEG,
939 (List.concat [comments, finish])
948 profileLabel = profileLabel,
949 statements = statements,
950 transfer = transfer})
957 [[Assembly.Instruction (Instruction.pMD
958 {oper = Instruction.MUL,
959 src = Operand.Immediate immediate,
965 => (case getImmediateLog2 (Immediate.destruct immediate)
966 of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
970 profileLabel = profileLabel,
971 statements = List.fold(start,
972 List.concat [comments, finish],
974 transfer = transfer})
976 => if i < (8 * Size.toBytes size)
979 = (Assembly.instruction_sral
980 {oper = Instruction.SAL,
981 count = Operand.immediate_int i,
984 (List.concat [comments, finish])
993 profileLabel = profileLabel,
994 statements = statements,
995 transfer = transfer})
1004 [[Assembly.Instruction (Instruction.pMD
1005 {oper = Instruction.IDIV,
1006 src = Operand.Immediate immediate,
1012 => (case getImmediateLog2 (Immediate.destruct immediate)
1013 of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
1017 profileLabel = profileLabel,
1018 statements = List.fold(start,
1019 List.concat [comments, finish],
1021 transfer = transfer})
1025 = (Assembly.instruction_unal
1026 {oper = Instruction.NEG,
1029 (List.concat [comments, finish])
1038 profileLabel = profileLabel,
1039 statements = statements,
1040 transfer = transfer})
1043 => if i < (8 * Size.toBytes size)
1045 val divTemp = Operand.MemLoc (divTemp size)
1046 val width = 8 * Size.toBytes size
1050 => (Assembly.instruction_mov
1057 then (Assembly.instruction_sral
1058 {oper = Instruction.SAR,
1061 = Operand.immediate_int
1068 then (Assembly.instruction_sral
1069 {oper = Instruction.SHR,
1072 = Operand.immediate_int
1078 => (Assembly.instruction_binal
1079 {oper = Instruction.ADD,
1083 (Assembly.instruction_sral
1084 {oper = Instruction.SAR,
1085 count = Operand.immediate_int i,
1091 then (Assembly.instruction_unal
1092 {oper = Instruction.NEG,
1097 (List.concat [comments, finish])
1106 profileLabel = profileLabel,
1107 statements = statements,
1108 transfer = transfer})
1115 [[Assembly.Instruction (Instruction.pMD
1116 {oper = Instruction.DIV,
1117 src = Operand.Immediate immediate,
1123 => (case getImmediateLog2 (Immediate.destruct immediate)
1124 of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
1128 profileLabel = profileLabel,
1129 statements = List.fold(start,
1130 List.concat [comments, finish],
1132 transfer = transfer})
1134 => if i < (8 * Size.toBytes size)
1137 = (Assembly.instruction_sral
1138 {oper = Instruction.SHR,
1139 count = Operand.immediate_int i,
1142 (List.concat [comments, finish])
1151 profileLabel = profileLabel,
1152 statements = statements,
1153 transfer = transfer})
1156 | SOME (_,true) => NONE)
1161 [[Assembly.Instruction (Instruction.IMUL2
1162 {src = Operand.Immediate immediate,
1167 transfer as Transfer.Iff {condition,
1170 => (case getImmediateLog2 (Immediate.destruct immediate)
1171 of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
1177 => Transfer.Goto {target = falsee}
1179 => Transfer.Goto {target = truee}
1180 | _ => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:transfer"
1189 profileLabel = profileLabel,
1190 statements = statements,
1191 transfer = transfer})
1198 (Assembly.instruction_unal
1199 {oper = Instruction.NEG,
1207 profileLabel = profileLabel,
1208 statements = statements,
1209 transfer = transfer})
1218 then (Assembly.instruction_unal
1219 {oper = Instruction.NEG,
1224 ((Assembly.instruction_binal
1225 {oper = Instruction.ADD,
1234 profileLabel = profileLabel,
1235 statements = statements,
1236 transfer = transfer})
1243 [[Assembly.Instruction (Instruction.IMUL2
1244 {src = Operand.Immediate immediate,
1250 => (case getImmediateLog2 (Immediate.destruct immediate)
1251 of NONE => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2:getImmediateLog2"
1255 profileLabel = profileLabel,
1256 statements = List.fold(start,
1257 List.concat [comments, finish],
1259 transfer = transfer})
1263 = (Assembly.instruction_unal
1264 {oper = Instruction.NEG,
1267 (List.concat [comments, finish])
1276 profileLabel = profileLabel,
1277 statements = statements,
1278 transfer = transfer})
1287 then (Assembly.instruction_unal
1288 {oper = Instruction.NEG,
1293 ((Assembly.instruction_binal
1294 {oper = Instruction.ADD,
1298 (List.concat [comments, finish])),
1303 profileLabel = profileLabel,
1304 statements = statements,
1305 transfer = transfer})
1308 => if i < (8 * Size.toBytes size)
1312 => (Assembly.instruction_sral
1313 {oper = Instruction.SAL,
1314 count = Operand.immediate_int i,
1318 then (Assembly.instruction_unal
1319 {oper = Instruction.NEG,
1324 (List.concat [comments, finish])
1333 profileLabel = profileLabel,
1334 statements = statements,
1335 transfer = transfer})
1338 | _ => Error.bug "x86Simplify.PeeholeBlock: elimMDPow2"
1340 val (callback,elimMDPow2_msg)
1341 = make_callback_msg "elimMDPow2"
1343 val elimMDPow2 : optimization
1344 = {template = template,
1345 rewriter = rewriter,
1346 callback = callback}
1347 val elimMDPow2_msg = elimMDPow2_msg
1351 val isInstructionCMPorTEST : statement_type -> bool
1352 = fn Assembly.Instruction (Instruction.CMP _)
1354 | Assembly.Instruction (Instruction.TEST _)
1358 val isInstructionMOV : statement_type -> bool
1359 = fn Assembly.Instruction (Instruction.MOV _)
1363 val isInstructionSETcc : statement_type -> bool
1364 = fn Assembly.Instruction (Instruction.SETcc _)
1368 val isInstruction : statement_type -> bool
1369 = fn Assembly.Instruction _
1373 val isTransfer_Iff : transfer_type -> bool
1379 = {start = EmptyOrNonEmpty,
1380 statements = [One isInstructionCMPorTEST,
1382 finish = EmptyOrNonEmpty,
1383 transfer = fn _ => true}
1390 [[Assembly.Instruction _],
1396 = fn [] => not (isTransfer_Iff transfer)
1400 isInstructionMOV asm
1401 then scan statements
1402 else if isInstructionSETcc asm
1404 else if isInstruction asm
1412 List.concat [comments, finish],
1415 SOME (Block.T {entry = entry,
1416 profileLabel = profileLabel,
1417 statements = statements,
1418 transfer = transfer})
1422 | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMPTEST"
1424 val (callback,elimCMPTEST_msg)
1425 = make_callback_msg "elimCMPTEST"
1427 val elimCMPTEST : optimization
1428 = {template = template,
1429 rewriter = rewriter,
1430 callback = callback}
1431 val elimCMPTEST_msg = elimCMPTEST_msg
1435 val isInstructionCMP_srcImmediate0
1436 = fn Assembly.Instruction (Instruction.CMP
1437 {src1 = Operand.Immediate immediate,
1439 => Immediate.isZero immediate
1440 | Assembly.Instruction (Instruction.CMP
1441 {src2 = Operand.Immediate immediate,
1443 => Immediate.isZero immediate
1446 val isTransfer_Iff_E_NE
1447 = fn Transfer.Iff {condition, ...}
1448 => condition = Instruction.E
1450 condition = Instruction.NE
1454 = {start = EmptyOrNonEmpty,
1455 statements = [One isInstructionCMP_srcImmediate0,
1458 transfer = isTransfer_Iff_E_NE}
1465 [[Assembly.Instruction
1466 (Instruction.CMP {src1, src2, size})],
1469 transfer = Transfer.Iff {condition, truee, falsee}}
1473 of Instruction.E => Instruction.Z
1474 | Instruction.NE => Instruction.NZ
1475 | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMP0:condition"
1478 = case (Operand.deImmediate src1,
1479 Operand.deImmediate src2)
1480 of (SOME _, NONE) => src2
1481 | (NONE, SOME _) => src1
1482 | (SOME immediate1, SOME _)
1483 => if Immediate.isZero immediate1
1486 | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMP0:src"
1490 (Assembly.instruction_test
1498 = Transfer.Iff {condition = condition,
1502 SOME (Block.T {entry = entry,
1503 profileLabel = profileLabel,
1504 statements = statements,
1505 transfer = transfer})
1507 | _ => Error.bug "x86Simplify.PeeholeBlock: elimCMP0"
1509 val (callback,elimCMP0_msg)
1510 = make_callback_msg "elimCMP0"
1512 val elimCMP0 : optimization
1513 = {template = template,
1514 rewriter = rewriter,
1515 callback = callback}
1516 val elimCMP0_msg = elimCMP0_msg
1520 val isInstructionAL_setZF
1521 = fn Assembly.Instruction (Instruction.BinAL _)
1523 | Assembly.Instruction (Instruction.UnAL {oper, ...})
1525 of Instruction.NOT => false
1527 | Assembly.Instruction (Instruction.SRAL {oper, ...})
1529 of Instruction.ROL => false
1530 | Instruction.RCL => false
1531 | Instruction.ROR => false
1532 | Instruction.RCR => false
1536 val isInstructionTEST_eqSrcs
1537 = fn Assembly.Instruction (Instruction.TEST {src1, src2, ...})
1538 => Operand.eq(src1, src2)
1541 val isTransfer_Iff_Z_NZ
1542 = fn Transfer.Iff {condition, ...}
1543 => condition = Instruction.Z
1545 condition = Instruction.NZ
1549 = {start = EmptyOrNonEmpty,
1550 statements = [One isInstructionAL_setZF,
1552 One isInstructionTEST_eqSrcs,
1555 transfer = isTransfer_Iff_Z_NZ}
1562 [[Assembly.Instruction instruction],
1564 [Assembly.Instruction
1565 (Instruction.TEST {src1, ...})],
1568 transfer as Transfer.Iff {...}}
1572 of Instruction.BinAL {dst, ...} => dst
1573 | Instruction.UnAL {dst, ...} => dst
1574 | Instruction.SRAL {dst, ...} => dst
1575 | _ => Error.bug "x86Simplify.PeeholeBlock: elimALTEST:dst"
1577 if Operand.eq(dst,src1)
1582 (Assembly.instruction instruction)::
1583 (List.concat [comments1, comments2]),
1586 SOME (Block.T {entry = entry,
1587 profileLabel = profileLabel,
1588 statements = statements,
1589 transfer = transfer})
1593 | _ => Error.bug "x86Simplify.PeeholeBlock: elimALTEST"
1595 val (callback,elimALTEST_msg)
1596 = make_callback_msg "elimALTEST"
1598 val elimALTEST : optimization
1599 = {template = template,
1600 rewriter = rewriter,
1601 callback = callback}
1602 val elimALTEST_msg = elimALTEST_msg
1606 val optimizations_pre
1614 val optimizations_pre_msg
1615 = commuteBinALMD_msg::
1616 (* elimBinAL0L_msg:: *)
1617 (* elimBinAL0R_msg:: *)
1622 val optimizations_post
1623 = elimBinALMDDouble::
1629 val optimizations_post_msg
1630 = elimBinALMDDouble_msg::
1631 elimFltBinADouble_msg::
1637 val peepholeBlock_pre
1638 = fn block => (peepholeBlock {optimizations = optimizations_pre,
1640 val (peepholeBlock_pre, peepholeBlock_pre_msg)
1645 val peepholeBlock_pre_msg
1646 = fn () => (peepholeBlock_pre_msg ();
1648 List.foreach(optimizations_pre_msg, fn msg => msg ());
1649 Control.unindent ())
1651 val peepholeBlock_post
1652 = fn block => (peepholeBlock {optimizations = optimizations_post,
1654 val (peepholeBlock_post, peepholeBlock_post_msg)
1656 "peepholeBlock_post"
1659 val peepholeBlock_post_msg
1660 = fn () => (peepholeBlock_post_msg ();
1662 List.foreach(optimizations_post_msg, fn msg => msg ());
1663 Control.unindent ())
1666 val (callback_elimIff,elimIff_msg)
1667 = make_callback_msg "elimIff"
1668 fun makeElimIff {jumpInfo : x86JumpInfo.t} :
1671 val isTransferIff_eqTargets
1672 = fn Transfer.Iff {truee, falsee, ...}
1673 => Label.equals(truee, falsee)
1677 = {start = EmptyOrNonEmpty,
1680 transfer = isTransferIff_eqTargets}
1688 transfer = Transfer.Iff {truee, falsee, ...}}
1690 val _ = x86JumpInfo.decNear(jumpInfo, falsee)
1697 val transfer = Transfer.goto {target = truee}
1699 SOME (Block.T {entry = entry,
1700 profileLabel = profileLabel,
1701 statements = statements,
1702 transfer = transfer})
1704 | _ => Error.bug "x86Simplify.PeeholeBlock: elimIff"
1706 {template = template,
1707 rewriter = rewriter,
1708 callback = callback_elimIff}
1711 val (callback_elimSwitchTest,elimSwitchTest_msg)
1712 = make_callback_msg "elimSwitchTest"
1713 fun makeElimSwitchTest {jumpInfo : x86JumpInfo.t} :
1716 val isTransferSwitch_testImmediateEval
1717 = fn Transfer.Switch {test = Operand.Immediate immediate, ...}
1718 => isSome (Immediate.eval immediate)
1723 statements = [All (fn _ => true)],
1725 transfer = isTransferSwitch_testImmediateEval}
1731 statements = [statements'],
1734 Transfer.Switch {test = Operand.Immediate immediate,
1738 val statements = statements'
1739 val test = valOf (Immediate.eval immediate)
1741 = Transfer.Cases.keepAll
1744 => (x86JumpInfo.decNear(jumpInfo, target);
1745 WordX.equals (w, test)))
1748 = if Transfer.Cases.isEmpty cases
1749 then Transfer.goto {target = default}
1750 else if Transfer.Cases.isSingle cases
1752 val _ = x86JumpInfo.decNear
1756 = Transfer.Cases.extract
1758 val _ = x86JumpInfo.incNear
1761 Transfer.goto {target = target}
1763 else Error.bug "x86Simplify.PeeholeBlock: elimSwitchTest:transfer"
1765 SOME (Block.T {entry = entry,
1766 profileLabel = profileLabel,
1767 statements = statements,
1768 transfer = transfer})
1770 | _ => Error.bug "x86Simplify.PeeholeBlock: elimSwitchTest"
1772 {template = template,
1773 rewriter = rewriter,
1774 callback = callback_elimSwitchTest}
1777 val (callback_elimSwitchCases,elimSwitchCases_msg)
1778 = make_callback_msg "elimSwitchCases"
1779 fun makeElimSwitchCases {jumpInfo : x86JumpInfo.t} :
1782 val isTransferSwitch_casesDefault
1783 = fn Transfer.Switch {cases, default, ...}
1785 val n = Transfer.Cases.count
1787 fn target => Label.equals(target, default))
1795 statements = [All (fn _ => true)],
1797 transfer = isTransferSwitch_casesDefault}
1803 statements = [statements'],
1805 transfer = Transfer.Switch {test, cases, default}}
1807 val statements = statements'
1809 = Transfer.Cases.keepAll
1811 fn (_,target) => if Label.equals(target, default)
1812 then (x86JumpInfo.decNear
1817 val (statements, transfer)
1818 = if Transfer.Cases.isEmpty cases
1820 Transfer.goto {target = default})
1821 else if Transfer.Cases.isSingle cases
1824 = Transfer.Cases.extract
1827 (Immediate.word w, target))
1829 = case Operand.size test
1830 of SOME size => size
1835 [Assembly.instruction_cmp
1837 src2 = Operand.immediate k,
1839 Transfer.iff {condition = Instruction.E,
1844 Transfer.switch {test = test,
1848 SOME (Block.T {entry = entry,
1849 profileLabel = profileLabel,
1850 statements = statements,
1851 transfer = transfer})
1853 | _ => Error.bug "x86Simplify.PeeholeBlock: elimSwitchCases"
1855 {template = template,
1856 rewriter = rewriter,
1857 callback = callback_elimSwitchCases}
1861 structure ElimGoto =
1863 fun elimSimpleGoto {chunk = Chunk.T {data, blocks, ...},
1864 delProfileLabel : x86.ProfileLabel.t -> unit,
1865 jumpInfo : x86JumpInfo.t}
1867 val {get: Label.t -> Label.t option,
1868 set: Label.t * Label.t option -> unit,
1870 = Property.destGetSet(Label.plist, Property.initConst NONE)
1871 val changed = ref false
1876 fn Block.T {entry = Entry.Jump {label},
1879 transfer = Transfer.Goto {target}}
1880 => if List.forall(statements,
1881 fn Assembly.Comment _ => true
1885 not (Label.equals(label, target))
1887 then (Option.app(profileLabel, delProfileLabel);
1888 set(label, SOME target);
1894 = if List.fold(labels,
1903 => if Label.equals(label, target')
1904 then (set(label, NONE);
1906 else (set(label, SOME target');
1916 => (changed := true;
1917 x86JumpInfo.decNear(jumpInfo, target);
1918 x86JumpInfo.incNear(jumpInfo, target');
1923 = fn Transfer.Goto {target}
1924 => Transfer.Goto {target = update target}
1925 | Transfer.Iff {condition, truee, falsee}
1926 => Transfer.Iff {condition = condition,
1927 truee = update truee,
1928 falsee = update falsee}
1929 | Transfer.Switch {test, cases, default}
1930 => Transfer.Switch {test = test,
1931 cases = Transfer.Cases.map
1932 (cases, update o #2),
1933 default = update default}
1934 | transfer => transfer
1939 fn Block.T {entry, profileLabel, statements, transfer}
1940 => Block.T {entry = entry,
1941 profileLabel = profileLabel,
1942 statements = statements,
1943 transfer = elimSimpleGoto' transfer})
1948 fn Block.T {entry,...}
1949 => (case get (Entry.label entry)
1950 of SOME label' => (changed := true;
1951 x86JumpInfo.decNear(jumpInfo,
1958 {chunk = Chunk.T {data = data, blocks = blocks},
1962 val (elimSimpleGoto,elimSimpleGoto_msg)
1967 fun elimComplexGoto {chunk = Chunk.T {data, blocks, ...},
1968 jumpInfo : x86JumpInfo.t}
1970 datatype z = datatype x86JumpInfo.status
1972 val {get: Label.t -> Block.t option,
1973 set: Label.t * Block.t option -> unit,
1975 = Property.destGetSet(Label.plist, Property.initConst NONE)
1980 fn block as Block.T {entry = Entry.Jump {label},...}
1981 => if x86JumpInfo.getNear(jumpInfo, label) = Count 1
1982 then (set(label, SOME block); SOME label)
1996 transfer = Transfer.Goto {target}})
1997 => (if Label.equals(label,target)
1999 else (case get target
2003 profileLabel = profileLabel',
2004 statements = statements',
2005 transfer = transfer'})
2009 profileLabel = profileLabel,
2014 (Entry.label entry')],
2015 ProfileLabel.toAssemblyOpt
2027 val changed = ref false
2028 val elimComplexGoto'
2029 = fn block as Block.T {entry,
2032 transfer = Transfer.Goto {target}}
2033 => if Label.equals(Entry.label entry,target)
2035 else (case get target
2037 | SOME (Block.T {entry = entry',
2038 profileLabel = profileLabel',
2039 statements = statements',
2040 transfer = transfer'})
2042 val _ = changed := true
2043 val _ = x86JumpInfo.decNear
2046 val _ = List.foreach
2047 (Transfer.nearTargets transfer',
2049 => x86JumpInfo.incNear
2053 = Block.T {entry = entry,
2054 profileLabel = profileLabel,
2059 (Entry.label entry')],
2060 ProfileLabel.toAssemblyOpt
2063 transfer = transfer'}
2070 = List.map(blocks, elimComplexGoto')
2074 {chunk = Chunk.T {data = data, blocks = blocks},
2078 val (elimComplexGoto, elimComplexGoto_msg)
2083 fun elimBlocks {chunk = Chunk.T {data, blocks, ...},
2084 jumpInfo : x86JumpInfo.t}
2086 val {get = getIsBlock,
2088 destroy = destroyIsBlock}
2089 = Property.destGetSetOnce
2090 (Label.plist, Property.initConst false)
2092 val {get: Label.t -> {block: Block.t,
2096 = Property.destGetSetOnce
2097 (Label.plist, Property.initRaise ("gotoInfo", Label.layout))
2102 fn (block as Block.T {entry, ...}, (labels, funcs))
2104 val label = Entry.label entry
2106 setIsBlock(label, true);
2107 set(label, {block = block,
2108 reach = ref false}) ;
2110 of Entry.Func _ => (label::labels, label::funcs)
2111 | _ => (label::labels, funcs)
2116 val {block = Block.T {transfer, ...}, reach} = get label
2120 else (reach := true ;
2121 List.foreach (Transfer.nearTargets transfer, loop))
2123 val _ = List.foreach (funcs, loop)
2126 = case (Operand.deImmediate oper, Operand.deLabel oper)
2127 of (SOME immediate, _)
2128 => (case Immediate.deLabel immediate
2129 of SOME label => if getIsBlock label
2130 then ! (#reach (get label))
2133 | (_, SOME label) => if getIsBlock label
2134 then ! (#reach (get label))
2138 val changed = ref false
2144 val {block = Block.T {entry,
2154 profileLabel = profileLabel,
2158 fn Assembly.Instruction i
2159 => (case #srcs (Instruction.srcs_dsts i)
2162 => List.forall(srcs, check))
2164 transfer = transfer})
2165 else (changed := true ;
2167 (Transfer.nearTargets transfer,
2168 fn label => x86JumpInfo.decNear (jumpInfo, label));
2173 val _ = destroyIsBlock ()
2175 {chunk = Chunk.T {data = data, blocks = blocks},
2179 val (elimBlocks, elimBlocks_msg)
2184 fun elimGoto {chunk : Chunk.t,
2185 delProfileLabel: x86.ProfileLabel.t -> unit,
2186 jumpInfo : x86JumpInfo.t}
2189 = PeepholeBlock.makeElimIff {jumpInfo = jumpInfo}
2191 = PeepholeBlock.makeElimSwitchTest {jumpInfo = jumpInfo}
2193 = PeepholeBlock.makeElimSwitchCases {jumpInfo = jumpInfo}
2195 fun loop {chunk, changed}
2198 changed = changed_elimSimpleGoto}
2199 = elimSimpleGoto {chunk = chunk,
2200 delProfileLabel = delProfileLabel,
2201 jumpInfo = jumpInfo}
2203 val Chunk.T {data, blocks, ...} = chunk
2206 changed = changed_peepholeBlocks}
2207 = PeepholeBlock.peepholeBlocks
2209 optimizations = [elimIff,
2213 val chunk = Chunk.T {data = data, blocks = blocks}
2215 if changed_elimSimpleGoto orelse changed_peepholeBlocks
2216 then loop {chunk = chunk, changed = true}
2217 else {chunk = chunk, changed = changed}
2221 changed = changed_loop}
2222 = loop {chunk = chunk, changed = false}
2225 changed = changed_elimComplexGoto}
2226 = elimComplexGoto {chunk = chunk,
2227 jumpInfo = jumpInfo}
2230 changed = changed_elimBlocks}
2231 = elimBlocks {chunk = chunk,
2232 jumpInfo = jumpInfo}
2235 changed = changed_loop
2236 orelse changed_elimComplexGoto
2237 orelse changed_elimBlocks}
2240 val (elimGoto, elimGoto_msg)
2246 = fn () => (elimGoto_msg ();
2248 PeepholeBlock.elimIff_msg ();
2249 PeepholeBlock.elimSwitchTest_msg ();
2250 PeepholeBlock.elimSwitchCases_msg ();
2251 elimSimpleGoto_msg ();
2252 elimComplexGoto_msg ();
2254 Control.unindent ())
2257 structure MoveHoistLivenessBlock =
2259 structure LiveSet = x86Liveness.LiveSet
2260 structure Liveness = x86Liveness.Liveness
2261 structure LivenessBlock = x86Liveness.LivenessBlock
2263 fun moveHoist {block = LivenessBlock.T
2264 {entry, profileLabel, statements, transfer}}
2267 = LivenessBlock.reLivenessTransfer {transfer = transfer}
2269 val {statements, changed, moves, live}
2276 fn ((asm: Assembly.t, Liveness.T {dead,...}),
2277 {statements: (Assembly.t * Liveness.t) list,
2280 live: x86Liveness.LiveSet.t})
2284 val {uses,defs,...} = Assembly.uses_defs_kills asm
2290 fn (operand,baseUses)
2291 => case Operand.deMemloc operand
2298 else memloc::baseUses
2304 fn (operand,baseDefs)
2305 => case Operand.deMemloc operand
2312 else memloc::baseDefs
2317 fun doit(memlocs,allUses)
2323 (MemLoc.utilized memloc,
2331 else memloc::allUses))
2337 val allDefs = baseDefs
2348 fn (move as {src,dst,...},
2355 = MemLoc.utilized src
2357 = MemLoc.utilized dst
2366 (memloc', memloc'')))
2375 (memloc', memloc'')))
2385 then {forces = move::forces,
2394 else {forces = forces,
2395 moves = move::moves,
2403 fn {src,dst,size,age}
2409 val statements_forces
2412 fn {src,dst,size,...}
2413 => (case Size.class size
2415 => Assembly.instruction_mov
2416 {src = Operand.memloc src,
2417 dst = Operand.memloc dst,
2420 => Assembly.instruction_pfmov
2421 {src = Operand.memloc src,
2422 dst = Operand.memloc dst,
2425 val {statements = statements_asm_forces,
2427 = LivenessBlock.toLivenessStatements
2428 {statements = asm::statements_forces,
2433 [statements_asm_forces,
2446 of Assembly.Instruction
2448 {src = Operand.MemLoc memloc_src,
2449 dst = Operand.MemLoc memloc_dst,
2451 => if LiveSet.contains(dead,
2456 => MemLoc.eq(memloc_src,src))
2457 then {statements = statements,
2459 moves = {src = memloc_src,
2465 | Assembly.Instruction
2467 {src = Operand.MemLoc memloc_src,
2468 dst = Operand.MemLoc memloc_dst,
2470 => if LiveSet.contains(dead,
2475 => MemLoc.eq(memloc_src,src))
2476 then {statements = statements,
2478 moves = {src = memloc_src,
2488 val statements_forces
2491 fn {src,dst,size,...}
2492 => (case Size.class size
2494 => Assembly.instruction_mov
2495 {src = Operand.memloc src,
2496 dst = Operand.memloc dst,
2499 => Assembly.instruction_pfmov
2500 {src = Operand.memloc src,
2501 dst = Operand.memloc dst,
2503 val {statements = statements_forces,
2505 = LivenessBlock.toLivenessStatements
2506 {statements = statements_forces,
2508 val statements = List.concat [statements_forces,
2510 val changed = changed
2515 val block = LivenessBlock.T {entry = entry,
2516 profileLabel = profileLabel,
2517 statements = statements,
2518 transfer = transfer}
2525 = fn {block} => (moveHoist {block = block})
2528 {block: LivenessBlock.t} ->
2529 {block: LivenessBlock.t,
2537 structure CopyPropagateLivenessBlock =
2539 structure LiveSet = x86Liveness.LiveSet
2540 structure LiveInfo = x86Liveness.LiveInfo
2541 structure Liveness = x86Liveness.Liveness
2542 structure LivenessBlock = x86Liveness.LivenessBlock
2544 fun copyPropagate' {src,
2545 dst as Operand.MemLoc memloc_dst,
2546 pblock = {statements, transfer},
2552 of Operand.MemLoc memloc_src
2556 fun doit (memlocs, all)
2561 => if List.contains(all,
2567 doit(memloc_dst::(MemLoc.utilized memloc_dst),
2568 doit(memloc_src::(MemLoc.utilized memloc_src),
2572 fun replacer' memloc
2573 = if MemLoc.eq(memloc,memloc_dst)
2574 then (changed := !changed + 1;
2579 = fn {use,def} => fn operand
2580 => case Operand.deMemloc operand
2582 => if (use andalso not def)
2584 (not (MemLoc.eq(memloc, memloc_dst)))
2586 (MemLoc.replace replacer' memloc)
2596 fun doit (memlocs, all)
2601 => if List.contains(all,
2607 doit(memloc_dst::(MemLoc.utilized memloc_dst),
2614 => if use andalso not def
2615 then if Operand.eq(operand,dst)
2616 then (changed := !changed + 1;
2624 val (transfer,_) = transfer
2626 fun doit (statements : (Assembly.t * Liveness.t) list)
2628 fun uses_defs {uses, defs}
2635 fn (operand,memlocs)
2636 => case Operand.deMemloc operand
2638 => if List.contains(memlocs,
2642 else memloc::memlocs
2645 fun doit'(memlocs,uses)
2650 => if List.contains(uses,
2655 fun doit''(memlocs,uses)
2660 => doit'(MemLoc.utilized memloc, uses))
2662 val uses = doit uses
2663 val defs = doit defs
2664 val uses = doit''(defs,
2669 {uses = uses, defs = defs}
2675 val transfer = Transfer.replace replacer transfer
2676 val {uses,defs,...} = Transfer.uses_defs_kills transfer
2678 val {uses, defs} = uses_defs {uses = uses, defs = defs}
2680 if not (List.contains(uses,
2684 not (MemLocSet.contains(Transfer.live transfer,
2692 => not (MemLoc.mayAlias(memloc,
2694 then SOME {statements = [],
2695 transfer = transfer}
2699 | (asm, Liveness.T {dead, ...}) :: statements
2701 val asm = Assembly.replace replacer asm
2702 val {uses,defs,...} = Assembly.uses_defs_kills asm
2704 val {uses, defs} = uses_defs {uses = uses, defs = defs}
2706 if not (List.contains(uses,
2709 then if LiveSet.contains(dead,memloc_dst)
2712 = List.map (statements, #1)
2714 SOME {statements = asm::statements,
2715 transfer = transfer}
2723 => not (MemLoc.mayAlias(memloc,
2725 then case doit statements
2729 => SOME {statements = asm::statements,
2730 transfer = transfer}
2736 case doit statements
2738 | SOME {statements, transfer}
2740 val {transfer, live}
2741 = LivenessBlock.toLivenessTransfer
2742 {transfer = transfer,
2743 liveInfo = liveInfo}
2744 val {statements, ...}
2745 = LivenessBlock.toLivenessStatements
2746 {statements = statements,
2749 SOME {pblock = {statements = statements,
2750 transfer = transfer},
2751 changed = !changed > 0}
2754 | copyPropagate' _ = Error.bug "x86Simplify.PeeholeBlock: copyPropagate'"
2757 fun copyPropagate {block = LivenessBlock.T
2758 {entry, profileLabel, statements, transfer},
2761 val {pblock = {statements,transfer},changed}
2764 {pblock = {statements = [],
2765 transfer = transfer},
2767 fn ((asm as Assembly.Instruction
2770 dst as Operand.MemLoc memloc_dst,
2773 {pblock as {statements, transfer},
2776 val pblock' = {statements = (asm,info)::statements,
2777 transfer = transfer}
2779 if x86Liveness.track memloc_dst
2784 fn ((_, Liveness.T {dead,...}),b)
2785 => b orelse LiveSet.contains(dead,memloc_dst))
2787 LiveSet.contains(Liveness.dead(#2(transfer)),memloc_dst))
2788 then case copyPropagate' {src = src,
2791 liveInfo = liveInfo}
2792 of NONE => {pblock = pblock',
2796 => {pblock = pblock,
2797 changed = changed orelse changed'}
2798 else {pblock = pblock',
2801 | ((asm as Assembly.Instruction
2804 dst as Operand.MemLoc memloc_dst,
2807 {pblock as {statements, transfer},
2810 val pblock' = {statements = (asm,info)::statements,
2811 transfer = transfer}
2813 if x86Liveness.track memloc_dst
2818 fn ((_, Liveness.T {dead,...}),b)
2819 => b orelse LiveSet.contains(dead,memloc_dst))
2821 LiveSet.contains(Liveness.dead (#2 transfer),
2823 then case copyPropagate' {src = src,
2826 liveInfo = liveInfo}
2827 of NONE => {pblock = pblock',
2831 => {pblock = pblock,
2832 changed = changed orelse changed'}
2833 else {pblock = pblock',
2837 {pblock = {statements, transfer},
2839 => {pblock = {statements = (asm,info)::statements,
2840 transfer = transfer},
2843 {block = LivenessBlock.T {entry = entry,
2844 profileLabel = profileLabel,
2845 statements = statements,
2846 transfer = transfer},
2851 = fn {block, liveInfo}
2852 => (copyPropagate {block = block, liveInfo = liveInfo})
2854 val (copyPropagate :
2855 {block: LivenessBlock.t,
2856 liveInfo: LiveInfo.t} ->
2857 {block: LivenessBlock.t,
2865 fn arg as {block as LivenessBlock.T {statements, ...}, ...} =>
2866 if List.length statements <= !Control.Native.copyPropCutoff
2867 then copyPropagate arg
2868 else {block = block, changed = false}
2871 structure PeepholeLivenessBlock =
2873 structure LiveSet = x86Liveness.LiveSet
2874 structure Liveness = x86Liveness.Liveness
2875 structure LivenessBlock = x86Liveness.LivenessBlock
2878 = Peephole(type entry_type = Entry.t * Liveness.t
2879 type profileLabel_type = ProfileLabel.t option
2880 type statement_type = Assembly.t * Liveness.t
2881 type transfer_type = Transfer.t * Liveness.t
2882 datatype block = datatype LivenessBlock.t)
2885 fun make_callback_msg name
2889 val callback = fn true => (Int.inc count; Int.inc total)
2890 | false => Int.inc total
2891 val msg = fn () => Control.messageStr
2894 ": ", Int.toString (!count),
2895 " / ", Int.toString (!total)])
2900 val isComment : statement_type -> bool
2901 = fn (Assembly.Comment _, _) => true
2905 val isInstruction_dstsTemp_dstsDead : statement_type -> bool
2906 = fn (Assembly.Instruction instruction,
2907 Liveness.T {dead,...})
2909 val {dsts,...} = Instruction.srcs_dsts instruction
2913 | SOME dsts => List.forall
2915 fn Operand.MemLoc memloc
2916 => x86Liveness.track memloc
2918 LiveSet.contains(dead,memloc)
2923 val template : template
2924 = {start = EmptyOrNonEmpty,
2925 statements = [One isInstruction_dstsTemp_dstsDead],
2926 finish = EmptyOrNonEmpty,
2927 transfer = fn _ => true}
2929 val rewriter : rewriter
2934 [[(Assembly.Instruction _,
2935 Liveness.T {liveOut,...})]],
2938 => if (case List.fold
2939 (finish, (false, false), fn ((asm, _), (b, b')) =>
2941 of Assembly.Comment _ => (b, b')
2942 | Assembly.Instruction
2943 (Instruction.SETcc _)
2944 => (true, if b then b' else true)
2946 of (_, true) => true
2947 | (false, _) => (case #1 transfer
2948 of Transfer.Iff _ => true
2953 val {statements, live}
2954 = LivenessBlock.reLivenessStatements
2955 {statements = List.rev start,
2959 = LivenessBlock.reLivenessEntry
2964 = List.concat [statements, finish]
2966 SOME (LivenessBlock.T
2968 profileLabel = profileLabel,
2969 statements = statements,
2970 transfer = transfer})
2972 | _ => Error.bug "x86Simplify.PeeholeBlock: elimDeadDsts"
2974 val (callback,elimDeadDsts_msg)
2975 = make_callback_msg "elimDeadDsts"
2977 val elimDeadDsts : optimization
2978 = {template = template,
2979 rewriter = rewriter,
2980 callback = callback}
2981 val elimDeadDsts_msg = elimDeadDsts_msg
2985 val isInstructionMOV_dstTemp : statement_type -> bool
2986 = fn (Assembly.Instruction (Instruction.MOV
2987 {dst = Operand.MemLoc memloc,...}),
2989 => x86Liveness.track memloc
2992 val isInstructionAL_dstTemp : statement_type -> bool
2993 = fn (Assembly.Instruction (Instruction.BinAL
2994 {dst = Operand.MemLoc memloc,...}),
2996 => x86Liveness.track memloc
2997 | (Assembly.Instruction (Instruction.pMD
2998 {dst = Operand.MemLoc memloc,...}),
3001 => x86Liveness.track memloc
3002 | (Assembly.Instruction (Instruction.IMUL2
3003 {dst = Operand.MemLoc memloc,...}),
3006 => x86Liveness.track memloc
3007 | (Assembly.Instruction (Instruction.UnAL
3008 {dst = Operand.MemLoc memloc,...}),
3011 => x86Liveness.track memloc
3012 | (Assembly.Instruction (Instruction.SRAL
3013 {dst = Operand.MemLoc memloc,...}),
3016 => x86Liveness.track memloc
3019 val isInstructionMOV_srcTemp_srcDead : statement_type -> bool
3020 = fn (Assembly.Instruction (Instruction.MOV
3021 {src = Operand.MemLoc memloc,...}),
3022 Liveness.T {dead,...})
3023 => x86Liveness.track memloc
3025 LiveSet.contains(dead, memloc)
3028 val template : template
3029 = {start = EmptyOrNonEmpty,
3030 statements = [One isInstructionMOV_dstTemp,
3034 (isInstructionAL_dstTemp asm)),
3035 One isInstructionMOV_srcTemp_srcDead],
3036 finish = EmptyOrNonEmpty,
3037 transfer = fn _ => true}
3039 val rewriter : rewriter
3044 [[(Assembly.Instruction (Instruction.MOV
3046 dst = dst1 as Operand.MemLoc memloc1,
3050 [(Assembly.Instruction (Instruction.MOV
3051 {src = Operand.MemLoc memloc2,
3054 Liveness.T {liveOut = liveOut2,...})]],
3057 => if Size.eq(size1,size2) andalso
3058 MemLoc.eq(memloc1,memloc2) andalso
3061 fn (Assembly.Comment _, _) => true
3062 | (Assembly.Instruction (Instruction.BinAL
3064 dst = Operand.MemLoc memloc,
3068 => Size.eq(size1,size) andalso
3069 MemLoc.eq(memloc1,memloc) andalso
3071 of (Operand.MemLoc memloc_src,
3072 Operand.MemLoc memloc_dst2)
3074 (memloc_src::(MemLoc.utilized memloc_src),
3076 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
3077 | (Operand.Immediate _, _) => true
3079 | (Assembly.Instruction (Instruction.pMD
3081 dst = Operand.MemLoc memloc,
3085 => Size.eq(size1,size) andalso
3086 MemLoc.eq(memloc1,memloc) andalso
3088 of (Operand.MemLoc memloc_src,
3089 Operand.MemLoc memloc_dst2)
3091 (memloc_src::(MemLoc.utilized memloc_src),
3093 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
3094 | (Operand.Immediate _, _) => true
3096 | (Assembly.Instruction (Instruction.IMUL2
3098 dst = Operand.MemLoc memloc,
3101 => Size.eq(size1,size) andalso
3102 MemLoc.eq(memloc1,memloc) andalso
3104 of (Operand.MemLoc memloc_src,
3105 Operand.MemLoc memloc_dst2)
3107 (memloc_src::(MemLoc.utilized memloc_src),
3109 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
3110 | (Operand.Immediate _, _) => true
3112 | (Assembly.Instruction (Instruction.UnAL
3113 {dst = Operand.MemLoc memloc,
3117 => Size.eq(size1,size) andalso
3118 MemLoc.eq(memloc1,memloc)
3119 | (Assembly.Instruction (Instruction.SRAL
3121 dst = Operand.MemLoc memloc,
3125 => Size.eq(size1,size) andalso
3126 MemLoc.eq(memloc1,memloc) andalso
3128 of (Operand.MemLoc memloc_count,
3129 Operand.MemLoc memloc_dst2)
3131 (memloc_count::(MemLoc.utilized memloc_count),
3133 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
3134 | (Operand.Immediate _, _) => true
3136 | _ => Error.bug "x86Simplify.PeeholeBlock: elimALCopy")
3145 => if Operand.eq(operand,dst1)
3150 val {statements, ...}
3151 = LivenessBlock.toLivenessStatements
3153 = (Assembly.instruction_mov
3156 size = size1})::statements,
3161 List.concat [statements,
3165 SOME (LivenessBlock.T
3167 profileLabel = profileLabel,
3168 statements = statements,
3169 transfer = transfer})
3172 | _ => Error.bug "x86Simplify.PeeholeBlock: elimALCopy"
3174 val (callback,elimALCopy_msg)
3175 = make_callback_msg "elimALCopy"
3177 val elimALCopy : optimization
3178 = {template = template,
3179 rewriter = rewriter,
3180 callback = callback}
3181 val elimALCopy_msg = elimALCopy_msg
3185 val isInstructionMOV_eqSrcDst : statement_type -> bool
3186 = fn (Assembly.Instruction (Instruction.MOV
3187 {dst = Operand.MemLoc memloc1,
3188 src = Operand.MemLoc memloc2,...}),
3190 => MemLoc.eq(memloc1,memloc2)
3193 val template : template
3194 = {start = EmptyOrNonEmpty,
3195 statements = [One isInstructionMOV_eqSrcDst],
3196 finish = EmptyOrNonEmpty,
3197 transfer = fn _ => true}
3199 val rewriter : rewriter
3204 [[(Assembly.Instruction (Instruction.MOV
3205 {src = Operand.MemLoc memloc, ...}),
3206 Liveness.T {liveOut,...})]],
3209 => if List.exists (MemLoc.utilized memloc, x86Liveness.track)
3211 val {statements, live} =
3212 LivenessBlock.reLivenessStatements
3213 {statements = List.rev start,
3216 LivenessBlock.reLivenessEntry
3220 List.concat [statements, finish]
3222 SOME (LivenessBlock.T
3224 profileLabel = profileLabel,
3225 statements = statements,
3226 transfer = transfer})
3230 List.fold(start, finish, op ::)
3232 SOME (LivenessBlock.T
3234 profileLabel = profileLabel,
3235 statements = statements,
3236 transfer = transfer})
3238 | _ => Error.bug "x86Simplify.PeeholeBlock: elimSelfMove"
3240 val (callback,elimSelfMove_msg)
3241 = make_callback_msg "elimSelfMove"
3243 val elimSelfMove : optimization
3244 = {template = template,
3245 rewriter = rewriter,
3246 callback = callback}
3247 val elimSelfMove_msg = elimSelfMove_msg
3251 val isInstructionMOV_dstMemloc : statement_type -> bool
3252 = fn (Assembly.Instruction (Instruction.MOV
3253 {dst = Operand.MemLoc _,...}),
3258 val isInstructionBinALMD_dstMemloc_operCommute : statement_type -> bool
3259 = fn (Assembly.Instruction (Instruction.BinAL
3261 dst = Operand.MemLoc _,...}),
3263 => (oper = Instruction.ADD)
3265 (oper = Instruction.ADC)
3267 (oper = Instruction.AND)
3269 (oper = Instruction.OR)
3271 (oper = Instruction.XOR)
3272 | (Assembly.Instruction (Instruction.pMD
3274 dst = Operand.MemLoc _,...}),
3276 => (oper = Instruction.IMUL)
3278 (oper = Instruction.MUL)
3279 | (Assembly.Instruction (Instruction.IMUL2
3280 {dst = Operand.MemLoc _,...}),
3285 val template : template
3286 = {start = EmptyOrNonEmpty,
3287 statements = [One isInstructionMOV_dstMemloc,
3289 One isInstructionBinALMD_dstMemloc_operCommute],
3290 finish = EmptyOrNonEmpty,
3291 transfer = fn _ => true}
3293 val rewriter : rewriter
3298 [[(Assembly.Instruction (Instruction.MOV
3301 = dst1 as Operand.MemLoc memloc_dst1,
3303 Liveness.T {dead = dead1,...})],
3305 [(Assembly.Instruction (Instruction.BinAL
3309 = dst2 as Operand.MemLoc _,
3311 Liveness.T {dead = dead2,
3312 liveOut = liveOut2, ...})]],
3315 => if Size.eq(size1,size2) andalso
3316 Operand.eq(dst1,dst2) andalso
3317 not (Operand.eq(src1,src2)) andalso
3319 of (Operand.MemLoc memloc_src1,
3320 Operand.MemLoc memloc_src2)
3321 => LiveSet.contains(dead2,
3324 not (LiveSet.contains(dead1,
3326 | (_, Operand.MemLoc memloc_src2)
3327 => LiveSet.contains(dead2,
3329 | _ => false) andalso
3331 of Operand.MemLoc memloc_src1
3333 (memloc_src1::(MemLoc.utilized memloc_src1),
3335 => MemLoc.mayAlias(memloc',memloc_dst1)))
3336 | _ => true) andalso
3338 of Operand.MemLoc memloc_src2
3340 (memloc_src2::(MemLoc.utilized memloc_src2),
3342 => MemLoc.mayAlias(memloc',memloc_dst1)))
3346 = (Assembly.instruction_mov
3351 [List.map(comments, #1),
3352 [Assembly.instruction_binal
3358 val {statements, ...}
3359 = LivenessBlock.toLivenessStatements
3360 {statements = statements,
3365 List.concat [statements,
3369 SOME (LivenessBlock.T
3371 profileLabel = profileLabel,
3372 statements = statements,
3373 transfer = transfer})
3380 [[(Assembly.Instruction (Instruction.MOV
3383 = dst1 as Operand.MemLoc memloc_dst1,
3385 Liveness.T {dead = dead1,...})],
3387 [(Assembly.Instruction (Instruction.pMD
3391 = dst2 as Operand.MemLoc _,
3393 Liveness.T {dead = dead2,
3394 liveOut = liveOut2,...})]],
3397 => if Size.eq(size1,size2) andalso
3398 Operand.eq(dst1,dst2) andalso
3399 not (Operand.eq(src1,src2)) andalso
3401 of (Operand.MemLoc memloc_src1,
3402 Operand.MemLoc memloc_src2)
3403 => LiveSet.contains(dead2,
3406 not (LiveSet.contains(dead1,
3408 | (_, Operand.MemLoc memloc_src2)
3409 => LiveSet.contains(dead2,
3411 | _ => false) andalso
3413 of Operand.MemLoc memloc_src1
3415 (memloc_src1::(MemLoc.utilized memloc_src1),
3417 => MemLoc.mayAlias(memloc',memloc_dst1)))
3418 | _ => true) andalso
3420 of Operand.MemLoc memloc_src2
3422 (memloc_src2::(MemLoc.utilized memloc_src2),
3424 => MemLoc.mayAlias(memloc',memloc_dst1)))
3428 = (Assembly.instruction_mov
3433 [List.map(comments, #1),
3434 [Assembly.instruction_pmd
3440 val {statements, ...}
3441 = LivenessBlock.toLivenessStatements
3442 {statements = statements,
3447 List.concat [statements,
3451 SOME (LivenessBlock.T
3453 profileLabel = profileLabel,
3454 statements = statements,
3455 transfer = transfer})
3462 [[(Assembly.Instruction (Instruction.MOV
3465 = dst1 as Operand.MemLoc memloc_dst1,
3467 Liveness.T {dead = dead1,...})],
3469 [(Assembly.Instruction (Instruction.IMUL2
3472 = dst2 as Operand.MemLoc _,
3474 Liveness.T {dead = dead2,
3475 liveOut = liveOut2,...})]],
3478 => if Size.eq(size1,size2) andalso
3479 Operand.eq(dst1,dst2) andalso
3480 not (Operand.eq(src1,src2)) andalso
3482 of (Operand.MemLoc memloc_src1,
3483 Operand.MemLoc memloc_src2)
3484 => LiveSet.contains(dead2,
3487 not (LiveSet.contains(dead1,
3489 | (_, Operand.MemLoc memloc_src2)
3490 => LiveSet.contains(dead2,
3492 | _ => false) andalso
3494 of Operand.MemLoc memloc_src1
3496 (memloc_src1::(MemLoc.utilized memloc_src1),
3498 => MemLoc.mayAlias(memloc',memloc_dst1)))
3499 | _ => true) andalso
3501 of Operand.MemLoc memloc_src2
3503 (memloc_src2::(MemLoc.utilized memloc_src2),
3505 => MemLoc.mayAlias(memloc',memloc_dst1)))
3509 = (Assembly.instruction_mov
3514 [List.map(comments, #1),
3515 [Assembly.instruction_imul2
3520 val {statements, ...}
3521 = LivenessBlock.toLivenessStatements
3522 {statements = statements,
3527 List.concat [statements,
3531 SOME (LivenessBlock.T
3533 profileLabel = profileLabel,
3534 statements = statements,
3535 transfer = transfer})
3538 | _ => Error.bug "x86Simplify.PeeholeBlock: commuteBinALMD"
3540 val (callback,commuteBinALMD_msg)
3541 = make_callback_msg "commuteBinALMD"
3543 val commuteBinALMD : optimization
3544 = {template = template,
3545 rewriter = rewriter,
3546 callback = callback}
3547 val commuteBinALMD_msg = commuteBinALMD_msg
3551 val isInstructionFMOV_dstTemp : statement_type -> bool
3552 = fn (Assembly.Instruction (Instruction.pFMOV
3553 {dst = Operand.MemLoc memloc,...}),
3555 => x86Liveness.track memloc
3558 val isInstructionFltA_dstTemp : statement_type -> bool
3559 = fn (Assembly.Instruction (Instruction.pFBinA
3560 {dst = Operand.MemLoc memloc,...}),
3562 => x86Liveness.track memloc
3563 | (Assembly.Instruction (Instruction.pFUnA
3564 {dst = Operand.MemLoc memloc,...}),
3567 => x86Liveness.track memloc
3568 | (Assembly.Instruction (Instruction.pFPTAN
3569 {dst = Operand.MemLoc memloc,...}),
3572 => x86Liveness.track memloc
3573 | (Assembly.Instruction (Instruction.pFBinAS
3574 {dst = Operand.MemLoc memloc,...}),
3576 => x86Liveness.track memloc
3577 | (Assembly.Instruction (Instruction.pFBinASP
3578 {dst = Operand.MemLoc memloc,...}),
3580 => x86Liveness.track memloc
3583 val isInstructionFMOV_srcTemp_srcDead : statement_type -> bool
3584 = fn (Assembly.Instruction (Instruction.pFMOV
3585 {src = Operand.MemLoc memloc,...}),
3586 Liveness.T {dead,...})
3587 => x86Liveness.track memloc
3589 LiveSet.contains(dead, memloc)
3592 val template : template
3593 = {start = EmptyOrNonEmpty,
3594 statements = [One isInstructionFMOV_dstTemp,
3598 (isInstructionFltA_dstTemp asm)),
3599 One isInstructionFMOV_srcTemp_srcDead],
3600 finish = EmptyOrNonEmpty,
3601 transfer = fn _ => true}
3603 val rewriter : rewriter
3608 [[(Assembly.Instruction (Instruction.pFMOV
3610 dst = dst1 as Operand.MemLoc memloc1,
3614 [(Assembly.Instruction (Instruction.pFMOV
3615 {src = Operand.MemLoc memloc2,
3618 Liveness.T {liveOut = liveOut2,...})]],
3621 => if Size.eq(size1,size2) andalso
3622 MemLoc.eq(memloc1,memloc2) andalso
3625 fn (Assembly.Comment _, _) => true
3626 | (Assembly.Instruction (Instruction.pFBinA
3628 dst = Operand.MemLoc memloc,
3632 => Size.eq(size1,size) andalso
3633 MemLoc.eq(memloc1,memloc) andalso
3635 of (Operand.MemLoc memloc_src,
3636 Operand.MemLoc memloc_dst2)
3638 (memloc_src::(MemLoc.utilized memloc_src),
3640 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
3641 | (Operand.Immediate _, _) => true
3643 | (Assembly.Instruction (Instruction.pFUnA
3644 {dst = Operand.MemLoc memloc,
3648 => Size.eq(size1,size) andalso
3649 MemLoc.eq(memloc1,memloc)
3650 | (Assembly.Instruction (Instruction.pFPTAN
3651 {dst = Operand.MemLoc memloc,
3654 => Size.eq(size1,size) andalso
3655 MemLoc.eq(memloc1,memloc)
3656 | (Assembly.Instruction (Instruction.pFBinAS
3658 dst = Operand.MemLoc memloc,
3662 => Size.eq(size1,size) andalso
3663 MemLoc.eq(memloc1,memloc) andalso
3665 of (Operand.MemLoc memloc_src,
3666 Operand.MemLoc memloc_dst2)
3668 (memloc_src::(MemLoc.utilized memloc_src),
3670 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
3671 | (Operand.Immediate _, _) => true
3673 | (Assembly.Instruction (Instruction.pFBinASP
3675 dst = Operand.MemLoc memloc,
3679 => Size.eq(size1,size) andalso
3680 MemLoc.eq(memloc1,memloc) andalso
3682 of (Operand.MemLoc memloc_src,
3683 Operand.MemLoc memloc_dst2)
3685 (memloc_src::(MemLoc.utilized memloc_src),
3687 => not (MemLoc.mayAlias(memloc_dst2,memloc')))
3688 | (Operand.Immediate _, _) => true
3690 | _ => Error.bug "x86Simplify.PeeholeBlock: elimFltACopy")
3699 => if Operand.eq(operand,dst1)
3704 val {statements, ...}
3705 = LivenessBlock.toLivenessStatements
3707 = (Assembly.instruction_pfmov
3710 size = size1})::statements,
3715 List.concat [statements,
3719 SOME (LivenessBlock.T
3721 profileLabel = profileLabel,
3722 statements = statements,
3723 transfer = transfer})
3726 | _ => Error.bug "x86Simplify.PeeholeBlock: elimFltACopy"
3728 val (callback,elimFltACopy_msg)
3729 = make_callback_msg "elimFltACopy"
3731 val elimFltACopy : optimization
3732 = {template = template,
3733 rewriter = rewriter,
3734 callback = callback}
3735 val elimFltACopy_msg = elimFltACopy_msg
3739 val isInstructionFMOV_eqSrcDst : statement_type -> bool
3740 = fn (Assembly.Instruction (Instruction.pFMOV
3741 {dst = Operand.MemLoc memloc1,
3742 src = Operand.MemLoc memloc2,...}),
3744 => MemLoc.eq(memloc1,memloc2)
3747 val template : template
3748 = {start = EmptyOrNonEmpty,
3749 statements = [One isInstructionFMOV_eqSrcDst],
3750 finish = EmptyOrNonEmpty,
3751 transfer = fn _ => true}
3753 val rewriter : rewriter
3758 [[(Assembly.Instruction (Instruction.pFMOV
3770 SOME (LivenessBlock.T
3772 profileLabel = profileLabel,
3773 statements = statements,
3774 transfer = transfer})
3776 | _ => Error.bug "x86Simplify.PeeholeBlock: elimFltSelfMove"
3778 val (callback,elimFltSelfMove_msg)
3779 = make_callback_msg "elimFltSelfMove"
3781 val elimFltSelfMove : optimization
3782 = {template = template,
3783 rewriter = rewriter,
3784 callback = callback}
3785 val elimFltSelfMove_msg = elimFltSelfMove_msg
3789 val isInstructionFMOV_dstMemloc : statement_type -> bool
3790 = fn (Assembly.Instruction (Instruction.pFMOV
3791 {dst = Operand.MemLoc _,...}),
3796 val isInstructionFltBinA_dstMemloc : statement_type -> bool
3797 = fn (Assembly.Instruction (Instruction.pFBinA
3798 {dst = Operand.MemLoc _,...}),
3803 val template : template
3804 = {start = EmptyOrNonEmpty,
3805 statements = [One isInstructionFMOV_dstMemloc,
3807 One isInstructionFltBinA_dstMemloc],
3808 finish = EmptyOrNonEmpty,
3809 transfer = fn _ => true}
3811 val rewriter : rewriter
3816 [[(Assembly.Instruction (Instruction.pFMOV
3819 = dst1 as Operand.MemLoc memloc_dst1,
3821 Liveness.T {dead = dead1,...})],
3823 [(Assembly.Instruction (Instruction.pFBinA
3827 = dst2 as Operand.MemLoc _,
3829 Liveness.T {dead = dead2,
3830 liveOut = liveOut2,...})]],
3833 => if Size.eq(size1,size2) andalso
3834 Operand.eq(dst1,dst2) andalso
3835 not (Operand.eq(src1, src2)) andalso
3837 of (Operand.MemLoc memloc_src1,
3838 Operand.MemLoc memloc_src2)
3839 => LiveSet.contains(dead2,
3842 not (LiveSet.contains(dead1,
3844 | (_, Operand.MemLoc memloc_src2)
3845 => LiveSet.contains(dead2,
3847 | _ => false) andalso
3849 of Operand.MemLoc memloc_src1
3851 (memloc_src1::(MemLoc.utilized memloc_src1),
3853 => MemLoc.mayAlias(memloc',memloc_dst1)))
3854 | _ => true) andalso
3856 of Operand.MemLoc memloc_src2
3858 (memloc_src2::(MemLoc.utilized memloc_src2),
3860 => MemLoc.mayAlias(memloc',memloc_dst1)))
3864 = (Assembly.instruction_pfmov
3869 [List.map(comments, #1),
3870 [Assembly.instruction_pfbina
3871 {oper = Instruction.fbina_reverse oper2,
3876 val {statements, ...}
3877 = LivenessBlock.toLivenessStatements
3878 {statements = statements,
3883 List.concat [statements,
3887 SOME (LivenessBlock.T
3889 profileLabel = profileLabel,
3890 statements = statements,
3891 transfer = transfer})
3894 | _ => Error.bug "x86Simplify.PeeholeBlock: commuteFltBinA"
3896 val (callback,commuteFltBinA_msg)
3897 = make_callback_msg "commuteFltBinA"
3899 val commuteFltBinA : optimization
3900 = {template = template,
3901 rewriter = rewriter,
3902 callback = callback}
3903 val commuteFltBinA_msg = commuteFltBinA_msg
3907 val isInstructionSETcc : statement_type -> bool
3908 = fn (Assembly.Instruction (Instruction.SETcc
3914 val isInstructionTEST_eqSrcs : statement_type -> bool
3915 = fn (Assembly.Instruction (Instruction.TEST
3916 {src1 = Operand.MemLoc memloc1,
3917 src2 = Operand.MemLoc memloc2,...}),
3919 => MemLoc.eq(memloc1, memloc2)
3922 val isIff_conditionZorNZ : transfer_type -> bool
3923 = fn (Transfer.Iff {condition,...},
3926 of Instruction.Z => true
3927 | Instruction.NZ => true
3931 val template : template
3932 = {start = EmptyOrNonEmpty,
3933 statements = [One isInstructionSETcc,
3935 One isInstructionTEST_eqSrcs,
3938 transfer = isIff_conditionZorNZ}
3940 val rewriter : rewriter
3946 Assembly.Instruction (Instruction.SETcc
3947 {condition = condition1,
3949 = Operand.MemLoc memloc1,
3953 [(Assembly.Instruction (Instruction.TEST
3955 = Operand.MemLoc memloc12,
3957 Liveness.T {dead, ...})],
3961 (Transfer.Iff {condition, truee, falsee},
3963 => if MemLoc.eq(memloc1,memloc12)
3968 => Instruction.condition_negate condition1
3969 | Instruction.NZ => condition1
3970 | _ => Error.bug "x86Simplify.PeeholeBlock: conditionalJump:condition"
3973 = (Transfer.iff {condition = condition,
3979 = LivenessBlock.reLivenessTransfer
3980 {transfer = transfer}
3984 [List.map(comments1, #1),
3985 List.map(comments2, #1)]
3987 = if x86Liveness.track memloc1 andalso
3988 LiveSet.contains(dead, memloc1)
3990 else statement::statements
3992 val {statements, ...}
3993 = LivenessBlock.toLivenessStatements
3994 {statements = statements,
4004 of (_, Liveness.T {liveIn,...})::_ => liveIn
4005 | _ => Error.bug "x86Simplify.PeeholeBlock: conditionalJump:live"
4008 = LivenessBlock.reLivenessEntry
4012 SOME (LivenessBlock.T
4014 profileLabel = profileLabel,
4015 statements = statements,
4016 transfer = transfer})
4019 | _ => Error.bug "x86Simplify.PeeholeBlock: conditionalJump"
4021 val (callback,conditionalJump_msg)
4022 = make_callback_msg "conditionalJump"
4024 val conditionalJump : optimization
4025 = {template = template,
4026 rewriter = rewriter,
4027 callback = callback}
4028 val conditionalJump_msg = conditionalJump_msg
4032 val {template, rewriter, ...} = elimDeadDsts
4033 val (callback,elimDeadDsts_minor_msg)
4034 = make_callback_msg "elimDeadDsts_minor"
4036 val elimDeadDsts_minor : optimization
4037 = {template = template,
4038 rewriter = rewriter,
4039 callback = callback}
4040 val elimDeadDsts_minor_msg = elimDeadDsts_minor_msg
4044 val {template, rewriter, ...} = elimSelfMove
4045 val (callback,elimSelfMove_minor_msg)
4046 = make_callback_msg "elimSelfMove_minor"
4048 val elimSelfMove_minor : optimization
4049 = {template = template,
4050 rewriter = rewriter,
4051 callback = callback}
4052 val elimSelfMove_minor_msg = elimSelfMove_minor_msg
4056 val {template, rewriter, ...} = elimFltSelfMove
4057 val (callback,elimFltSelfMove_minor_msg)
4058 = make_callback_msg "elimFltSelfMove_minor"
4060 val elimFltSelfMove_minor : optimization
4061 = {template = template,
4062 rewriter = rewriter,
4063 callback = callback}
4064 val elimFltSelfMove_minor_msg = elimFltSelfMove_minor_msg
4078 val optimizations_msg
4083 elimFltSelfMove_msg::
4084 commuteBinALMD_msg::
4085 commuteFltBinA_msg::
4086 conditionalJump_msg::
4089 val optimizations_minor
4090 = elimDeadDsts_minor::
4091 elimSelfMove_minor::
4092 elimFltSelfMove_minor::
4094 val optimizations_minor_msg
4095 = elimDeadDsts_minor_msg::
4096 elimSelfMove_minor_msg::
4097 elimFltSelfMove_minor_msg::
4100 val peepholeLivenessBlock
4101 = fn block => (peepholeBlock {optimizations = optimizations,
4104 val (peepholeLivenessBlock, peepholeLivenessBlock_msg)
4106 "peepholeLivenessBlock"
4107 peepholeLivenessBlock
4109 val peepholeLivenessBlock_msg
4110 = fn () => (peepholeLivenessBlock_msg ();
4112 List.foreach(optimizations_msg, fn msg => msg ());
4113 Control.unindent ())
4115 val peepholeLivenessBlock_minor
4116 = fn block => (peepholeBlock {optimizations = optimizations_minor,
4119 val (peepholeLivenessBlock_minor, peepholeLivenessBlock_minor_msg)
4121 "peepholeLivenessBlock_minor"
4122 peepholeLivenessBlock_minor
4124 val peepholeLivenessBlock_minor_msg
4125 = fn () => (peepholeLivenessBlock_minor_msg ();
4127 List.foreach(optimizations_minor_msg, fn msg => msg ());
4128 Control.unindent ())
4132 fun simplify {chunk : Chunk.t,
4134 delProfileLabel : x86.ProfileLabel.t -> unit,
4135 liveInfo : x86Liveness.LiveInfo.t,
4136 jumpInfo : x86JumpInfo.t} :
4140 fun changedChunk_msg
4141 {chunk as Chunk.T {blocks, ...}, changed, msg}
4142 = (print ("finished " ^ msg ^ "\n"))
4143 fun changedBlock_msg
4144 {block as Block.T {entry, ...}, changed, msg}
4145 = (print ("finished " ^ msg ^ "\n"))
4146 fun changedLivenessBlock_msg
4147 {block as x86Liveness.LivenessBlock.T {entry, ...}, changed, msg}
4148 = if changed then (print ("finished " ^ msg ^ "\n")) else ()
4151 fun changedChunk_msg
4152 {chunk = Chunk.T {blocks, ...}, changed, msg}
4153 = if not changed then () else
4154 (print (String.make (60, #"*"));
4158 List.foreach(blocks,
4159 fn b as Block.T {entry, ...}
4162 (concat o List.separate)
4164 (x86Liveness.LiveSet.toList
4165 (x86Liveness.LiveInfo.getLive
4166 (liveInfo, Entry.label entry)),
4167 fn memloc => MemLoc.toString memloc),
4170 x86.Block.printBlock b)))
4172 fun changedBlock_msg
4173 {block as Block.T {entry, ...}, changed, msg}
4174 = if not changed then () else
4175 (print (String.make (60, #"*"));
4181 (concat o List.separate)
4183 (x86Liveness.LiveSet.toList
4184 (x86Liveness.LiveInfo.getLive
4185 (liveInfo, Entry.label entry)),
4186 fn memloc => MemLoc.toString memloc),
4189 x86.Block.printBlock block))
4191 fun changedLivenessBlock_msg
4192 {block as x86Liveness.LivenessBlock.T {entry, ...}, changed, msg}
4193 = if not changed then () else
4194 (print (String.make (60, #"*"));
4200 (concat o List.separate)
4202 (x86Liveness.LiveSet.toList
4203 (x86Liveness.LiveInfo.getLive
4204 (liveInfo, Entry.label (#1 entry))),
4205 fn memloc => MemLoc.toString memloc),
4208 x86Liveness.LivenessBlock.printBlock block))
4211 val changedChunk_msg : {chunk : Chunk.t, changed: bool, msg: string} -> unit =
4212 if debug then changedChunk_msg else (fn _ => ())
4213 val changedBlock_msg : {block : Block.t, changed: bool, msg: string} -> unit =
4214 if debug then changedBlock_msg else (fn _ => ())
4215 val changedLivenessBlock_msg : {block : x86Liveness.LivenessBlock.t, changed: bool, msg: string} -> unit =
4216 if debug then changedLivenessBlock_msg else (fn _ => ())
4218 fun checkLivenessBlock
4219 {block, block', msg}
4221 ("x86Simplify.checkLivenessBlock: " ^ msg,
4222 fn () => if x86Liveness.LivenessBlock.verifyLivenessBlock
4224 liveInfo = liveInfo}
4226 else (print ("pre: " ^ msg);
4227 x86Liveness.LivenessBlock.printBlock block;
4228 print (String.make(60, #"*"));
4230 print ("post: " ^ msg);
4231 x86Liveness.LivenessBlock.printBlock block';
4232 print (String.make(60, #"*"));
4236 (*********************************************************************)
4238 (*********************************************************************)
4240 val _ = changedChunk_msg
4245 (*********************************************************************)
4246 (* completeLiveInfo *)
4247 (*********************************************************************)
4248 val _ = x86Liveness.LiveInfo.completeLiveInfo
4250 liveInfo = liveInfo,
4253 val _ = changedChunk_msg
4256 msg = "completeLiveInfo (pre):"}
4258 (*********************************************************************)
4259 (* completeJumpInfo *)
4260 (*********************************************************************)
4261 val _ = x86JumpInfo.completeJumpInfo
4263 jumpInfo = jumpInfo}
4267 ("x86Simplify.verifyEntryTransfer",
4268 fn () => x86EntryTransfer.verifyEntryTransfer
4271 (*********************************************************************)
4273 (*********************************************************************)
4279 (**************************************************************)
4281 (**************************************************************)
4282 val {chunk = chunk',
4284 = ElimGoto.elimGoto {chunk = chunk,
4285 delProfileLabel = delProfileLabel,
4286 jumpInfo = jumpInfo}
4290 ("x86Simplify.verifyJumpInfo",
4291 fn () => x86JumpInfo.verifyJumpInfo
4293 jumpInfo = jumpInfo})
4297 ("x86Simplify.verifyEntryTransfer",
4298 fn () => x86EntryTransfer.verifyEntryTransfer
4301 val _ = changedChunk_msg
4304 msg = "ElimGoto.elimGoto:"}
4306 val changed = changed orelse changed'
4308 (**************************************************************)
4309 (* peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate*)
4310 (**************************************************************)
4311 val Chunk.T {data, blocks} = chunk
4312 val {blocks = blocks',
4316 {blocks = [], changed = false},
4317 fn (block, {blocks, changed})
4319 val _ = changedBlock_msg
4322 msg = "peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate"}
4323 (***************************************************)
4324 (* peepholeBlock_pre *)
4325 (***************************************************)
4326 val {block = block',
4328 = PeepholeBlock.peepholeBlock_pre block
4330 val _ = changedBlock_msg
4333 msg = "PeepholeBlock.peepholeBlock_pre"}
4335 val changed = changed orelse changed'
4337 (***************************************************)
4338 (* toLivenessBlock *)
4339 (***************************************************)
4341 = x86Liveness.LivenessBlock.toLivenessBlock
4343 liveInfo = liveInfo}
4346 val _ = changedLivenessBlock_msg
4349 msg = "x86Liveness.LivenessBlock.toLivenessBlock"}
4351 (***************************************************)
4353 (***************************************************)
4354 val {block = block',
4356 = if !Control.Native.moveHoist
4357 then MoveHoistLivenessBlock.moveHoist
4359 else {block = block,
4362 val _ = checkLivenessBlock
4365 msg = "MoveHoistLivenessBlock.moveHoist"}
4367 val _ = changedLivenessBlock_msg
4370 msg = "MoveHoistLivenessBlock.moveHoist"}
4372 val changed = changed orelse changed'
4374 (***************************************************)
4375 (* peepholeLivenessBlock *)
4376 (***************************************************)
4377 val {block = block',
4379 = PeepholeLivenessBlock.peepholeLivenessBlock block
4381 val _ = checkLivenessBlock
4384 msg = "PeepholeLivenessBlock.peepholeLivenessBlock"}
4386 val _ = changedLivenessBlock_msg
4389 msg = "PeepholeLivenessBlock.peepholeLivenessBlock"}
4391 val changed = changed orelse changed'
4393 (***************************************************)
4395 (***************************************************)
4396 val {block = block',
4398 = if !Control.Native.copyProp
4399 then CopyPropagateLivenessBlock.copyPropagate
4401 liveInfo = liveInfo}
4402 else {block = block,
4405 val _ = checkLivenessBlock
4408 msg = "CopyPropagateLivenessBlock.copyPropagate"}
4410 val _ = changedLivenessBlock_msg
4413 msg = "CopyPropagateLivenessBlock.copyPropagate"}
4415 val changed = changed orelse changed'
4417 (***************************************************)
4418 (* peepholeLivenessBlock_minor *)
4419 (***************************************************)
4420 val {block = block',
4422 = PeepholeLivenessBlock.peepholeLivenessBlock_minor block
4424 val _ = checkLivenessBlock
4427 msg = "PeepholeLivenessBlock.peepholeLivenessBlock_minor"}
4429 val _ = changedLivenessBlock_msg
4432 msg = "PeepholeLivenessBlock.peepholeLivenessBlock_minor"}
4434 val changed = changed orelse changed'
4436 (***************************************************)
4438 (***************************************************)
4440 = x86Liveness.LivenessBlock.toBlock {block = block}
4442 val _ = changedBlock_msg
4445 msg = "x86Liveness.LivenessBlock.toBlock"}
4448 (***************************************************)
4449 (* peepholeBlock_post *)
4450 (***************************************************)
4451 val {block = block',
4453 = PeepholeBlock.peepholeBlock_post block
4455 val _ = changedBlock_msg
4458 msg = "PeepholeBlock.peepholeBlock_post"}
4460 val changed = changed orelse changed'
4462 {blocks = block::blocks,
4465 val chunk' = Chunk.T {data = data, blocks = blocks'}
4467 val _ = changedChunk_msg
4470 msg = "peepholeBlock/moveHoist/peepholeLivenessBlock/copyPropagate"}
4472 val changed = changed orelse changed'
4474 (**************************************************************)
4475 (* completeLiveInfo *)
4476 (**************************************************************)
4478 = x86Liveness.LiveInfo.completeLiveInfo
4480 liveInfo = liveInfo,
4483 val _ = changedChunk_msg
4486 msg = "completeLiveInfo (post):"}
4492 (*********************************************************************)
4493 (* optimizer_loop *)
4494 (*********************************************************************)
4495 fun optimizer_loop chunk
4497 fun loop {chunk, changed}
4499 val {chunk, changed = changed'}
4503 then loop {chunk = chunk,
4505 else {chunk = chunk,
4509 val {chunk, changed}
4510 = loop {chunk = chunk, changed = false}
4517 (*********************************************************************)
4519 (*********************************************************************)
4522 of 0 => {chunk = chunk, changed = false}
4523 | 1 => optimizer chunk
4524 | _ => optimizer_loop chunk
4529 val (simplify, simplify_msg)
4534 fun simplify_totals ()
4537 x86Liveness.LiveInfo.completeLiveInfo_msg ();
4538 x86JumpInfo.completeJumpInfo_msg ();
4539 ElimGoto.elimGoto_msg ();
4540 x86JumpInfo.verifyJumpInfo_msg ();
4541 x86EntryTransfer.verifyEntryTransfer_msg ();
4542 PeepholeBlock.peepholeBlock_pre_msg ();
4543 x86Liveness.LivenessBlock.toLivenessBlock_msg ();
4544 MoveHoistLivenessBlock.moveHoist_msg ();
4545 PeepholeLivenessBlock.peepholeLivenessBlock_msg ();
4546 CopyPropagateLivenessBlock.copyPropagate_msg ();
4547 PeepholeLivenessBlock.peepholeLivenessBlock_minor_msg ();
4548 x86Liveness.LivenessBlock.verifyLivenessBlock_msg ();
4549 x86Liveness.LivenessBlock.toBlock_msg ();
4550 PeepholeBlock.peepholeBlock_post_msg ();
4551 Control.unindent ())