1 (* Copyright (C) 2012 Matthew Fluet.
2 * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
4 * Copyright (C) 1997-2000 NEC Research Institute.
6 * MLton is released under a BSD-style license.
7 * See the file MLton-LICENSE for details.
10 functor amd64 (S: AMD64_STRUCTS): AMD64 =
14 = fn s => Control.traceBatch (Control.Pass, s)
16 = fn s => fn f => (Control.trace (Control.Pass, s) f, fn () => ())
19 = fn s => Control.traceBatch (Control.Detail, s)
21 = fn s => fn f => (Control.trace (Control.Detail, s) f, fn () => ())
24 (* compensate for differences between
25 * C-escape sequences and ASM-escape sequences
27 val Char_escapeASM = fn #"\000" => "\\000"
33 fun String_escapeASM s = String.translate(s, Char_escapeASM)
40 if Relation.equals(ord, EQUAL)
53 if !Control.labelsHaveExtra_
54 then concat ["_", Label.toString l]
57 val layout = Layout.str o toString
62 datatype class = INT | FLT
65 = BYTE | WORD | LONG | QUAD
79 val toString = Layout.toString o layout
81 val fromBytes : int -> t
86 | _ => Error.bug "amd64.Size.fromBytes"
87 val toBytes : t -> int
96 datatype z = datatype CType.t
100 CPointer => Vector.new1 QUAD
101 | Int8 => Vector.new1 BYTE
102 | Int16 => Vector.new1 WORD
103 | Int32 => Vector.new1 LONG
104 | Int64 => Vector.new1 QUAD
105 | Objptr => Vector.new1 QUAD
106 | Real32 => Vector.new1 SNGL
107 | Real64 => Vector.new1 DBLE
108 | Word8 => Vector.new1 BYTE
109 | Word16 => Vector.new1 WORD
110 | Word32 => Vector.new1 LONG
111 | Word64 => Vector.new1 QUAD
122 val eq = fn (s1, s2) => s1 = s2
123 val lt = fn (s1, s2) => (toBytes s1) < (toBytes s2)
130 = RAX | RBX | RCX | RDX | RDI | RSI | RBP | RSP
131 | R8 | R9 | R10 | R11 | R12 | R13 | R14 | R15 | RIP
132 val allReg = [RAX, RBX, RCX, RDX, RDI, RSI, RBP, RSP,
133 R8, R9, R10, R11, R12, R13, R14, R15]
138 datatype t = T of {reg: reg, part: part}
140 fun size (T {part, ...})
147 fun layout (T {reg, part})
152 val {prefix, suffix} =
154 R => {prefix = "%r", suffix = "x"}
155 | E => {prefix = "%e", suffix = "x"}
156 | X => {prefix = "%", suffix = "x"}
157 | L => {prefix = "%", suffix = "l"}
159 str (String.concat [prefix, base, suffix])
163 val {prefix, suffix} =
165 R => {prefix = "%r", suffix = ""}
166 | E => {prefix = "%e", suffix = ""}
167 | X => {prefix = "%", suffix = ""}
168 | L => {prefix = "%", suffix = "l"}
170 str (String.concat [prefix, base, suffix])
177 | E => {suffix = "d"}
178 | X => {suffix = "w"}
179 | L => {suffix = "b"}
181 str (String.concat ["%", base, suffix])
203 val toString = Layout.toString o layout
205 fun eq(T r1, T r2) = r1 = r2
207 val rax = T {reg = RAX, part = R}
208 val eax = T {reg = RAX, part = E}
209 val ax = T {reg = RAX, part = X}
210 val al = T {reg = RAX, part = L}
211 val rbx = T {reg = RBX, part = R}
212 val ebx = T {reg = RBX, part = E}
213 val bl = T {reg = RBX, part = L}
214 val rcx = T {reg = RCX, part = R}
215 val ecx = T {reg = RCX, part = E}
216 val cl = T {reg = RCX, part = L}
217 val rdx = T {reg = RDX, part = R}
218 val edx = T {reg = RCX, part = E}
219 val dl = T {reg = RDX, part = L}
220 val rdi = T {reg = RDI, part = R}
221 val rsi = T {reg = RSI, part = R}
222 val rsp = T {reg = RSP, part = R}
223 val rbp = T {reg = RBP, part = R}
224 val r8 = T {reg = R8, part = R}
225 val r8w = T {reg = R8, part = X}
226 val r9 = T {reg = R9, part = R}
227 val r9w = T {reg = R9, part = X}
228 val r10 = T {reg = R10, part = R}
229 val r10w = T {reg = R10, part = X}
230 val r11 = T {reg = R11, part = R}
231 val r11w = T {reg = R11, part = X}
232 val r12 = T {reg = R12, part = R}
233 val r12w = T {reg = R12, part = X}
234 val r13 = T {reg = R13, part = R}
235 val r13w = T {reg = R13, part = X}
236 val r14 = T {reg = R14, part = R}
237 val r14w = T {reg = R14, part = X}
238 val r15 = T {reg = R15, part = R}
239 val r15w = T {reg = R15, part = X}
240 val rip = T {reg = RIP, part = R}
245 [T {reg = RAX, part = part},
246 T {reg = RBX, part = part},
247 T {reg = RCX, part = part},
248 T {reg = RDX, part = part},
249 T {reg = RDI, part = part},
250 T {reg = RSI, part = part},
251 T {reg = RBP, part = part},
252 T {reg = RSP, part = part},
253 T {reg = R8, part = part},
254 T {reg = R9, part = part},
255 T {reg = R10, part = part},
256 T {reg = R11, part = part},
257 T {reg = R12, part = part},
258 T {reg = R13, part = part},
259 T {reg = R14, part = part},
260 T {reg = R15, part = part}]
262 val byteRegisters = make L
263 val wordRegisters = make X
264 val longRegisters = make E
265 val quadRegisters = make R
268 val all = List.concat [byteRegisters, wordRegisters,
269 longRegisters, quadRegisters]
271 fun valid r = List.contains(all, r, eq)
274 = fn (R, R) => true | (R, E) => true | (R, X) => true | (R, L) => true
275 | (E, E) => true | (E, X) => true | (E, L) => true
276 | (X, X) => true | (X, L) => true
280 fun coincide (T {reg = reg1, part = part1},
281 T {reg = reg2, part = part2})
282 = reg1 = reg2 andalso (contains(part1,part2) orelse
283 contains(part2,part1))
286 = List.keepAllMap([R, E, X, L],
289 val register' = T {reg = reg, part = part}
291 if valid register' andalso
292 coincide(T {reg = reg, part = E}, register')
298 = fn Size.BYTE => byteRegisters
299 | Size.WORD => wordRegisters
300 | Size.LONG => longRegisters
301 | Size.QUAD => quadRegisters
302 | _ => Error.bug "amd64.Register.registers"
304 val baseRegisters = quadRegisters
305 val indexRegisters = [T {reg = RAX, part = R},
306 T {reg = RBX, part = R},
307 T {reg = RCX, part = R},
308 T {reg = RDX, part = R},
309 T {reg = RDI, part = R},
310 T {reg = RSI, part = R},
311 T {reg = RBP, part = R},
312 T {reg = R8, part = R},
313 T {reg = R9, part = R},
314 T {reg = R10, part = R},
315 T {reg = R11, part = R},
316 T {reg = R12, part = R},
317 T {reg = R13, part = R},
318 T {reg = R14, part = R},
319 T {reg = R15, part = R}]
323 [T {reg = reg, part = R},
324 T {reg = reg, part = E},
325 T {reg = reg, part = X},
326 T {reg = reg, part = L}]
328 val callerSaveRegisters =
329 List.concatMap ([RAX, RCX, RDX, RDI, RSI, R8, R9, R10, R11], make)
330 val calleeSaveRegisters =
331 List.concatMap ([RBX, R12, R13, R14, R15], make)
334 val withLowPart (* (fullsize,lowsize) *)
335 = fn (Size.WORD,Size.BYTE) => wordRegisters
336 | (Size.LONG,Size.BYTE) => longRegisters
337 | (Size.QUAD,Size.BYTE) => quadRegisters
338 | (Size.LONG,Size.WORD) => longRegisters
339 | (Size.QUAD,Size.WORD) => quadRegisters
340 | (Size.QUAD,Size.LONG) => quadRegisters
341 | _ => Error.bug "amd64.Register.withLowPart: fullsize,lowsize"
343 val lowPartOf (* (register,lowsize) *)
344 = fn (T {reg, ...},Size.BYTE) => T {reg = reg, part = L}
345 | (T {reg, ...},Size.WORD) => T {reg = reg, part = X}
346 | (T {reg, ...},Size.LONG) => T {reg = reg, part = E}
347 | _ => Error.bug "amd64.Register.lowPartOf: register,lowsize"
350 structure XmmRegister =
354 = XMM0 | XMM1 | XMM2 | XMM3 | XMM4 | XMM5 | XMM6 | XMM7
355 | XMM8 | XMM9 | XMM10 | XMM11 | XMM12 | XMM13 | XMM14 | XMM15
356 val allReg = [XMM0, XMM1, XMM2, XMM3, XMM4, XMM5, XMM6, XMM7,
357 XMM8, XMM9, XMM10, XMM11, XMM12, XMM13, XMM14, XMM15]
362 datatype t = T of {reg: reg, part: part}
364 fun size (T {part, ...})
369 fun layout (T {reg, ...})
374 of XMM0 => str "%xmm0"
375 | XMM1 => str "%xmm1"
376 | XMM2 => str "%xmm2"
377 | XMM3 => str "%xmm3"
378 | XMM4 => str "%xmm4"
379 | XMM5 => str "%xmm5"
380 | XMM6 => str "%xmm6"
381 | XMM7 => str "%xmm7"
382 | XMM8 => str "%xmm8"
383 | XMM9 => str "%xmm9"
384 | XMM10 => str "%xmm10"
385 | XMM11 => str "%xmm11"
386 | XMM12 => str "%xmm12"
387 | XMM13 => str "%xmm13"
388 | XMM14 => str "%xmm14"
389 | XMM15 => str "%xmm15"
391 val toString = Layout.toString o layout
393 fun eq(T r1, T r2) = r1 = r2
395 val xmm0S = T {reg = XMM0, part = S}
396 val xmm0D = T {reg = XMM0, part = D}
397 val xmm1S = T {reg = XMM1, part = S}
398 val xmm1D = T {reg = XMM1, part = D}
399 val xmm2S = T {reg = XMM2, part = S}
400 val xmm2D = T {reg = XMM2, part = D}
401 val xmm3S = T {reg = XMM3, part = S}
402 val xmm3D = T {reg = XMM3, part = D}
403 val xmm4S = T {reg = XMM4, part = S}
404 val xmm4D = T {reg = XMM4, part = D}
405 val xmm5S = T {reg = XMM5, part = S}
406 val xmm5D = T {reg = XMM5, part = D}
407 val xmm6S = T {reg = XMM6, part = S}
408 val xmm6D = T {reg = XMM6, part = D}
409 val xmm7S = T {reg = XMM7, part = S}
410 val xmm7D = T {reg = XMM7, part = D}
411 val xmm8S = T {reg = XMM8, part = S}
412 val xmm8D = T {reg = XMM8, part = D}
413 val xmm9S = T {reg = XMM9, part = S}
414 val xmm9D = T {reg = XMM9, part = D}
415 val xmm10S = T {reg = XMM10, part = S}
416 val xmm10D = T {reg = XMM10, part = D}
417 val xmm11S = T {reg = XMM11, part = S}
418 val xmm11D = T {reg = XMM11, part = D}
419 val xmm12S = T {reg = XMM12, part = S}
420 val xmm12D = T {reg = XMM12, part = D}
421 val xmm13S = T {reg = XMM13, part = S}
422 val xmm13D = T {reg = XMM13, part = D}
423 val xmm14S = T {reg = XMM14, part = S}
424 val xmm14D = T {reg = XMM14, part = D}
425 val xmm15S = T {reg = XMM15, part = S}
426 val xmm15D = T {reg = XMM15, part = D}
431 [T {reg = XMM0, part = part},
432 T {reg = XMM1, part = part},
433 T {reg = XMM2, part = part},
434 T {reg = XMM3, part = part},
435 T {reg = XMM4, part = part},
436 T {reg = XMM5, part = part},
437 T {reg = XMM6, part = part},
438 T {reg = XMM7, part = part},
439 T {reg = XMM8, part = part},
440 T {reg = XMM9, part = part},
441 T {reg = XMM10, part = part},
442 T {reg = XMM11, part = part},
443 T {reg = XMM12, part = part},
444 T {reg = XMM13, part = part},
445 T {reg = XMM14, part = part},
446 T {reg = XMM15, part = part}]
448 val singleRegisters = make S
449 val doubleRegisters = make D
452 val all = List.concat [singleRegisters, doubleRegisters]
454 fun valid r = List.contains(all, r, eq)
457 = fn (D, D) => true | (D, S) => true
461 fun coincide (T {reg = reg1, part = part1},
462 T {reg = reg2, part = part2})
463 = reg1 = reg2 andalso (contains(part1,part2) orelse
464 contains(part2,part1))
467 = List.keepAllMap([D, S],
470 val register' = T {reg = reg, part = part}
472 if valid register' andalso
473 coincide(T {reg = reg, part = D}, register')
478 fun coincident (T {reg, ...}) = coincident' reg
479 (* quell unused warning *)
483 = fn Size.SNGL => singleRegisters
484 | Size.DBLE => doubleRegisters
485 | _ => Error.bug "amd64.XmmRegister.registers"
487 val callerSaveRegisters = all
488 val calleeSaveRegisters = []
491 structure Immediate =
496 | LabelPlusWord of Label.t * WordX.t
498 = T of {immediate: u,
499 plist: PropertyList.t,
506 = fn Word w => WordX.layout w
507 | Label l => Label.layout l
508 | LabelPlusWord (l, w)
509 => paren (seq [Label.layout l, str "+", WordX.layout w])
511 = fn T {immediate, ...} => layoutU immediate
515 = fn (Word w1, Word w2) => WordX.equals (w1, w2)
516 | (Label l1, Label l2) => Label.equals(l1, l2)
517 | (LabelPlusWord (l1, w1), LabelPlusWord (l2,w2))
518 => Label.equals(l1,l2) andalso WordX.equals(w1, w2)
521 = fn (T {plist = plist1, ...},
522 T {plist = plist2, ...})
523 => PropertyList.equals(plist1, plist2)
529 = fn Word w => SOME w
531 | LabelPlusWord _ => NONE
533 = fn T {immediate, ...} => evalU immediate
536 val isZero = fn i => case eval i of SOME w => WordX.isZero w | _ => false
542 = fn Word w => WordX.hash w
543 | Label l => Label.hash l
544 | LabelPlusWord (l,w)
545 => Word.xorb(0wx5555 * (Label.hash l), WordX.hash w)
547 = fn T {hash, ...} => hash
551 val table: t HashSet.t ref = ref (HashSet.new {hash = hash})
556 val hash = hashU immediate
558 HashSet.lookupOrInsert
561 fn T {immediate = immediate', ...}
562 => eqU(immediate', immediate),
563 fn () => T {immediate = immediate,
565 plist = PropertyList.new ()})
569 = fn T {immediate, ...} => immediate
573 (!table, fn T {immediate, plist, ...} =>
575 PropertyList.clear plist;
578 | Label l => Label.clear l
579 | LabelPlusWord (l, _) => Label.clear l
583 val word = construct o Word
584 val label = construct o Label
585 val labelPlusWord = fn (l, w) =>
586 if WordSize.equals (WordX.size w, WordSize.word64)
587 then construct (LabelPlusWord (l, w))
588 else Error.bug "amd64.Immediate.labelPlusWord"
590 val int' = fn (i, ws) => word (WordX.fromIntInf (IntInf.fromInt i, ws))
591 val int = fn i => int' (i, WordSize.word64)
594 val labelPlusInt = fn (l, i) =>
595 labelPlusWord (l, WordX.fromIntInf (IntInf.fromInt i, WordSize.word64))
598 = fn T {immediate = Label l, ...} => SOME l
605 = One | Two | Four | Eight
617 val fromBytes : int -> t
622 | _ => Error.bug "amd64.Scale.fromBytes"
624 datatype z = datatype CType.t
642 fun eq(s1, s2) = s1 = s2
645 = fn One => WordX.fromIntInf (1, WordSize.word64)
646 | Two => WordX.fromIntInf (2, WordSize.word64)
647 | Four => WordX.fromIntInf (4, WordSize.word64)
648 | Eight => WordX.fromIntInf (8, WordSize.word64)
649 val toImmediate = Immediate.word o toWordX
654 datatype t = T of {disp: Immediate.t option,
655 base: Register.t option,
656 index: Register.t option,
657 scale: Scale.t option}
659 fun layout (T {disp, base, index, scale})
665 | SOME disp => Immediate.layout disp,
666 if (isSome base orelse isSome index)
671 => Register.layout base,
675 => seq [str ",", Register.layout index],
679 => seq [str ",", Scale.layout scale]])
683 fun eq(T {disp = disp, base = base, index = index, scale = scale},
684 T {disp = disp', base = base', index = index', scale = scale'})
685 = (case (disp, disp')
686 of (NONE, NONE) => true
687 | (SOME disp, SOME disp') => Immediate.eq(disp, disp')
688 | _ => false) andalso
690 index = index' andalso
698 val counter = Counter.new 0
699 datatype t = T of {counter: int,
702 fun layout (T {name, ...})
708 val toString = Layout.toString o layout
712 val class = T {counter = Counter.next counter,
719 = fn (T {counter = counter1, ...},
720 T {counter = counter2, ...})
721 => counter1 = counter2
723 = fn (T {counter = counter1, ...},
724 T {counter = counter2, ...})
725 => Int.compare (counter1, counter2)
727 = fn (T {counter, ...}) => counter
730 val Temp = new {name = "Temp"}
731 val StaticTemp = new {name = "StaticTemp"}
732 val CArg = new {name = "CArg"}
733 val CStack = new {name = "CStack"}
734 val Code = new {name = "Code"}
738 = U of {immBase: Immediate.t option,
740 immIndex: Immediate.t option,
748 plist: PropertyList.t,
756 = fn (NONE, NONE) => str "0"
757 | (SOME imm, NONE) => Immediate.layout imm
758 | (NONE, SOME mem) => layout mem
759 | (SOME imm, SOME mem) => seq [Immediate.layout imm,
763 and layoutImmMemScale
764 = fn (NONE, NONE, _) => str "0"
765 | (SOME imm, NONE, _) => Immediate.layout imm
766 | (NONE, SOME mem, scale) => seq [layout mem,
769 | (SOME imm, SOME mem, scale) => seq [Immediate.layout imm,
776 = fn U {immBase, memBase,
785 layoutImmMem (immBase, memBase),
787 layoutImmMemScale (immIndex, memIndex, scale),
790 = fn T {memloc, ...} => layoutU memloc
792 val toString = Layout.toString o layout
795 = fn (NONE, NONE) => 0wx55555555
796 | (SOME imm, NONE) => Immediate.hash imm
797 | (NONE, SOME mem) => hash mem
798 | (SOME imm, SOME mem)
799 => Word.xorb(0wx5555 * (Immediate.hash imm), hash mem)
801 = fn U {immBase, memBase, immIndex, memIndex, ...}
803 val hashBase = hashImmMem(immBase, memBase)
804 val hashIndex = hashImmMem(immIndex, memIndex)
806 Word.xorb(0wx5555 * hashBase, hashIndex)
809 = fn T {hash, ...} => hash
812 = fn (NONE, NONE) => true
813 | (SOME imm1, SOME imm2) => Immediate.eq(imm1, imm2)
816 = fn (NONE, NONE) => true
817 | (SOME mem1, SOME mem2) => eq(mem1, mem2)
820 = fn (U {immBase = immBase1, memBase = memBase1,
821 immIndex = immIndex1, memIndex = memIndex1,
822 scale = scale1, size = size1,
824 U {immBase = immBase2, memBase = memBase2,
825 immIndex = immIndex2, memIndex = memIndex2,
826 scale = scale2, size = size2,
828 => Class.eq(class1, class2) andalso
829 eqImm(immBase1, immBase2) andalso
830 eqMem(memBase1, memBase2) andalso
831 eqImm(immIndex1, immIndex2) andalso
832 eqMem(memIndex1, memIndex2) andalso
833 Scale.eq(scale1, scale2) andalso
834 Size.eq(size1, size2)
836 = fn (T {plist = plist1, ...},
837 T {plist = plist2, ...})
838 => PropertyList.equals(plist1, plist2)
842 | SOME m => m::(utilized m)
844 = fn U {memBase, memIndex, ...}
845 => (utilizedMem memBase) @ (utilizedMem memIndex)
847 = fn T {utilized, ...}
851 val counter = Counter.new 0
852 val table: t HashSet.t ref = ref (HashSet.new {hash = hash})
857 val hash = hashU memloc
859 HashSet.lookupOrInsert
862 fn T {memloc = memloc', ...} => eqU(memloc', memloc),
863 fn () => T {memloc = memloc,
865 plist = PropertyList.new (),
866 counter = Counter.next counter,
867 utilized = utilizedU memloc})
876 (!table, fn T {plist, ...} =>
878 PropertyList.clear plist
882 val rec mayAliasImmIndex
883 = fn ({immIndex = immIndex1, size = size1},
884 {immIndex = immIndex2, size = size2})
886 val size1 = IntInf.fromInt (Size.toBytes size1)
887 val size2 = IntInf.fromInt (Size.toBytes size2)
889 case (Immediate.eval (case immIndex1
890 of NONE => Immediate.zero
891 | SOME immIndex => immIndex),
892 Immediate.eval (case immIndex2
893 of NONE => Immediate.zero
894 | SOME immIndex => immIndex))
895 of (SOME pos1, SOME pos2)
897 val pos1 = WordX.toIntInfX pos1
898 val pos2 = WordX.toIntInfX pos2
901 then pos2 < (pos1 + size1)
902 else pos1 < (pos2 + size2)
904 handle Overflow => false)
908 = fn (U {immBase = SOME immBase1, memBase = NONE,
909 immIndex = immIndex1, memIndex = NONE,
911 U {immBase = SOME immBase2, memBase = NONE,
912 immIndex = immIndex2, memIndex = NONE,
914 => Immediate.eq(immBase1, immBase2)
916 mayAliasImmIndex ({immIndex = immIndex1,
918 {immIndex = immIndex2,
920 | (U {immBase = SOME immBase1, memBase = NONE,
921 immIndex = immIndex1, memIndex = SOME memIndex1,
923 U {immBase = SOME immBase2, memBase = NONE,
924 immIndex = immIndex2, memIndex = SOME memIndex2,
926 => not (Immediate.eq(immBase1, immBase2))
928 (not (eq(memIndex1, memIndex2))
930 mayAliasImmIndex ({immIndex = immIndex1,
932 {immIndex = immIndex2,
934 | (U {immBase = NONE, memBase = SOME memBase1,
935 immIndex = immIndex1, memIndex = NONE,
937 U {immBase = NONE, memBase = SOME memBase2,
938 immIndex = immIndex2, memIndex = NONE,
940 => not (eq(memBase1, memBase2))
942 mayAliasImmIndex ({immIndex = immIndex1,
944 {immIndex = immIndex2,
946 | (U {immBase = NONE, memBase = SOME memBase1,
947 immIndex = immIndex1, memIndex = SOME memIndex1,
949 U {immBase = NONE, memBase = SOME memBase2,
950 immIndex = immIndex2, memIndex = SOME memIndex2,
952 => not (eq(memBase1, memBase2))
954 not (eq(memIndex1, memIndex2))
956 mayAliasImmIndex ({immIndex = immIndex1,
958 {immIndex = immIndex2,
962 = fn (T {memloc = memloc1 as U {class = class1, ...}, ...},
963 T {memloc = memloc2 as U {class = class2, ...}, ...})
964 => Class.mayAlias(class1, class2) andalso
965 mayAliasU(memloc1, memloc2)
967 val rec mayAliasOrdImmIndex
968 = fn ({immIndex = immIndex1, size = size1},
969 {immIndex = immIndex2, size = size2})
971 val size1 = IntInf.fromInt (Size.toBytes size1)
972 val size2 = IntInf.fromInt (Size.toBytes size2)
974 case (Immediate.eval (case immIndex1
975 of NONE => Immediate.zero
976 | SOME immIndex => immIndex),
977 Immediate.eval (case immIndex2
978 of NONE => Immediate.zero
979 | SOME immIndex => immIndex))
980 of (SOME pos1, SOME pos2)
982 val pos1 = WordX.toIntInfX pos1
983 val pos2 = WordX.toIntInfX pos2
986 then if pos2 < (pos1 + size1)
989 else if pos1 < (pos2 + size2)
993 handle Overflow => NONE)
997 = fn (U {immBase = SOME immBase1, memBase = NONE,
998 immIndex = immIndex1, memIndex = NONE,
1000 U {immBase = SOME immBase2, memBase = NONE,
1001 immIndex = immIndex2, memIndex = NONE,
1003 => if Immediate.eq(immBase1, immBase2)
1004 then mayAliasOrdImmIndex ({immIndex = immIndex1,
1006 {immIndex = immIndex2,
1009 | (U {immBase = SOME immBase1, memBase = NONE,
1010 immIndex = immIndex1, memIndex = SOME memIndex1,
1012 U {immBase = SOME immBase2, memBase = NONE,
1013 immIndex = immIndex2, memIndex = SOME memIndex2,
1015 => if Immediate.eq(immBase1, immBase2)
1016 then if not (eq(memIndex1, memIndex2))
1018 else mayAliasOrdImmIndex ({immIndex = immIndex1,
1020 {immIndex = immIndex2,
1023 | (U {immBase = NONE, memBase = SOME memBase1,
1024 immIndex = immIndex1, memIndex = NONE,
1026 U {immBase = NONE, memBase = SOME memBase2,
1027 immIndex = immIndex2, memIndex = NONE,
1029 => if not (eq(memBase1, memBase2))
1031 else mayAliasOrdImmIndex ({immIndex = immIndex1,
1033 {immIndex = immIndex2,
1035 | (U {immBase = NONE, memBase = SOME memBase1,
1036 immIndex = immIndex1, memIndex = SOME memIndex1,
1038 U {immBase = NONE, memBase = SOME memBase2,
1039 immIndex = immIndex2, memIndex = SOME memIndex2,
1041 => if (not (eq(memBase1, memBase2))
1043 not (eq(memIndex1, memIndex2)))
1045 else mayAliasOrdImmIndex ({immIndex = immIndex1,
1047 {immIndex = immIndex2,
1051 = fn (T {memloc = memloc1 as U {class = class1, ...}, ...},
1052 T {memloc = memloc2 as U {class = class2, ...}, ...})
1053 => if Class.mayAlias(class1, class2)
1054 then mayAliasOrdU(memloc1, memloc2)
1058 = fn (T {counter = counter1, ...},
1059 T {counter = counter2, ...})
1060 => Int.compare(counter1, counter2)
1062 fun replaceMem replacer
1064 | SOME mem => SOME (replace replacer mem)
1065 and replaceU replacer
1066 = fn memloc as T {memloc = U {immBase, memBase, immIndex, memIndex,
1067 scale, size, class}, ...}
1069 val memBase' = replaceMem replacer memBase
1070 val memIndex' = replaceMem replacer memIndex
1072 if eqMem(memBase, memBase') andalso eqMem(memIndex, memIndex')
1074 else construct (U {immBase = immBase,
1076 immIndex = immIndex,
1077 memIndex = memIndex',
1082 and replace replacer
1085 val memloc' = replacer memloc
1087 if eq(memloc', memloc)
1088 then replaceU replacer memloc
1092 val rec sizeU = fn U {size, ...} => size
1093 and size = fn T {memloc, ...} => sizeU memloc
1094 val rec classU = fn U {class, ...} => class
1095 and class = fn T {memloc, ...} => classU memloc
1097 fun scaleImmediate (imm, scale) =
1098 case Immediate.destruct imm of
1099 Immediate.Word w => Immediate.word (WordX.mul (w,
1100 Scale.toWordX scale,
1102 | _ => Error.bug "amd64.MemLoc.scaleImmediate"
1104 fun addImmediate (imm1, imm2) =
1105 case (Immediate.destruct imm1, Immediate.destruct imm2) of
1106 (Immediate.Word w1, Immediate.Word w2) => Immediate.word (WordX.add (w1, w2))
1107 | _ => Error.bug "amd64.MemLoc.scaleImmediate"
1109 val imm = fn {base, index, scale, size, class}
1110 => construct (U {immBase = SOME base,
1112 immIndex = SOME (scaleImmediate (index, scale)),
1117 val basic = fn {base, index, scale, size, class}
1118 => construct (U {immBase = SOME base,
1121 memIndex = SOME index,
1125 val simple = fn {base, index, scale, size, class}
1126 => construct (U {immBase = NONE,
1127 memBase = SOME base,
1128 immIndex = SOME (scaleImmediate (index, scale)),
1134 val complex = fn {base, index, scale, size, class}
1135 => construct (U {immBase = NONE,
1136 memBase = SOME base,
1138 memIndex = SOME index,
1142 val shift = fn {origin, disp, scale, size}
1144 val disp = scaleImmediate (disp, scale)
1145 val U {immBase, memBase,
1147 scale, class, ...} =
1150 construct (U {immBase = immBase,
1155 | SOME immIndex => SOME (addImmediate (immIndex, disp)),
1156 memIndex = memIndex,
1163 val num : int ref = ref 0
1165 val temp = fn {size} => (Int.inc num;
1166 imm {base = Immediate.zero,
1167 index = Immediate.int (!num),
1170 class = Class.Temp})
1174 * Static memory locations
1176 fun makeContents {base, size, class}
1178 index = Immediate.zero,
1179 scale = Scale.Eight,
1184 datatype z = datatype CType.t
1185 datatype z = datatype Size.t
1187 fun cReturnTempContents sizes =
1190 (sizes, ([],0), fn (size, (contents, index)) =>
1191 ((cReturnTempContent (index, size))::contents,
1192 index + Size.toBytes size)))
1193 fun cReturnTempContent size =
1194 List.first(cReturnTempContents [size])
1195 val cReturnTempContents = fn size =>
1196 cReturnTempContents (
1198 Int s => let datatype z = datatype IntSize.t
1203 | I64 => [LONG, LONG]
1206 | Real s => let datatype z = datatype RealSize.t
1211 | Word s => let datatype z = datatype WordSize.t
1222 structure ClassElement =
1224 type t = MemLoc.Class.t
1225 val compare = MemLoc.Class.compare
1227 fun make f = fn (a, b) => f (MemLoc.Class.counter a, MemLoc.Class.counter b)
1229 val op < = make Int.<
1230 val op > = make Int.>
1231 val op >= = make Int.>=
1232 val op <= = make Int.<=
1234 val min = fn (a, b) => if Int.<(MemLoc.Class.counter a, MemLoc.Class.counter b)
1237 val max = fn (a, b) => min (b, a)
1238 val equals = MemLoc.Class.eq
1239 val layout = MemLoc.Class.layout
1242 structure ClassSet = OrderedUniqueSet(open ClassElement)
1245 structure MemLocElement =
1248 val equals = MemLoc.eq
1249 val layout = MemLoc.layout
1251 val compare = MemLoc.compare
1253 fun make f = fn (a, b) => f (MemLoc.counter a, MemLoc.counter b)
1255 val op < = make Int.<
1256 val op > = make Int.>
1257 val op >= = make Int.>=
1258 val op <= = make Int.<=
1260 val min = fn (a, b) => if Int.<(MemLoc.counter a, MemLoc.counter b)
1263 val max = fn (a, b) => min (b, a)
1264 val hash = MemLoc.hash
1268 structure MemLocSet = UnorderedSet(open MemLocElement)
1270 structure MemLocSet = OrderedUniqueSet(open MemLocElement)
1273 structure MemLocSet' = UnorderedSet(open MemLocElement)
1274 structure MemLocSet = HashedUniqueSet(structure Set = MemLocSet'
1275 structure Element = MemLocElement)
1282 = Register of Register.t
1283 | XmmRegister of XmmRegister.t
1284 | Immediate of Immediate.t
1286 | Address of Address.t
1287 | MemLoc of MemLoc.t
1290 = fn Register r => SOME (Register.size r)
1291 | XmmRegister x => SOME (XmmRegister.size x)
1292 | Immediate _ => NONE
1295 | MemLoc m => SOME (MemLoc.size m)
1301 fn Register r => Register.layout r
1302 | XmmRegister x => XmmRegister.layout x
1303 | Immediate i => seq [str "$", Immediate.layout i]
1304 | Label l => Label.layout l
1305 | Address a => Address.layout a
1306 | MemLoc m => MemLoc.layout m
1308 val toString = Layout.toString o layout
1311 = fn (Register r1, Register r2) => Register.eq(r1, r2)
1312 | (XmmRegister x1, XmmRegister x2) => XmmRegister.eq(x1, x2)
1313 | (Immediate i1, Immediate i2) => Immediate.eq(i1, i2)
1314 | (Label l1, Label l2) => Label.equals(l1, l2)
1315 | (Address a1, Address a2) => Address.eq(a1, a2)
1316 | (MemLoc m1, MemLoc m2) => MemLoc.eq(m1, m2)
1320 = fn (Register r1, Register r2) => Register.eq(r1, r2)
1321 | (Register _, _) => false
1322 | (XmmRegister x1, XmmRegister x2) => XmmRegister.eq(x1, x2)
1323 | (XmmRegister _, _) => false
1324 | (Immediate i1, Immediate i2) => Immediate.eq(i1, i2)
1325 | (Immediate _, _) => false
1326 | (Label l1, Label l2) => Label.equals(l1, l2)
1327 | (Label _, _) => false
1328 | (Address _, Address _) => true
1329 | (Address _, MemLoc _) => true
1330 | (Address _, _) => false
1331 | (MemLoc m1, MemLoc m2) => MemLoc.mayAlias(m1, m2)
1332 | (MemLoc _, Address _) => true
1333 | (MemLoc _, _) => false
1335 val register = Register
1337 = fn Register x => SOME x
1339 val xmmregister = XmmRegister
1341 = fn XmmRegister x => SOME x
1343 val immediate = Immediate
1345 = fn Immediate x => SOME x
1347 val immediate_word = immediate o Immediate.word
1348 val immediate_int' = immediate o Immediate.int'
1349 val immediate_int = immediate o Immediate.int
1350 val immediate_zero = immediate Immediate.zero
1351 val immediate_label = immediate o Immediate.label
1354 = fn Label x => SOME x
1356 val address = Address
1358 fun memloc_label l =
1359 memloc (MemLoc.makeContents { base = Immediate.label l,
1361 class = MemLoc.Class.Code })
1363 = fn MemLoc x => SOME x
1367 val cReturnTemp = Label.fromString "cReturnTemp"
1368 fun cReturnTempContent (index, size) =
1370 {base = Immediate.label cReturnTemp,
1371 index = Immediate.int index,
1374 class = MemLoc.Class.StaticTemp}
1375 datatype z = datatype CType.t
1376 datatype z = datatype Size.t
1378 fun cReturnTemps ty =
1379 if RepType.isUnit ty
1384 [{src = register r, dst = cReturnTempContent (0, s)}]
1385 val w8 = w (Register.al, BYTE)
1386 val w16 = w (Register.ax, WORD)
1387 val w32 = w (Register.eax, LONG)
1388 val w64 = w (Register.rax, QUAD)
1390 [{src = xmmregister x, dst = cReturnTempContent (0, s)}]
1391 val x32 = x (XmmRegister.xmm0S, SNGL)
1392 val x64 = x (XmmRegister.xmm0D, DBLE)
1394 case RepType.toCType ty of
1411 structure Instruction =
1413 (* Integer binary arithmetic(w/o mult & div)/logic instructions. *)
1415 = ADD (* signed/unsigned addition; p. 58 *)
1416 | ADC (* signed/unsigned addition with carry; p. 56 *)
1417 | SUB (* signed/unsigned subtraction; p. 234 *)
1418 | SBB (* signed/unsigned subtraction with borrow; p. 216 *)
1419 | AND (* logical and; p. 60 *)
1420 | OR (* logical or; p. 176 *)
1421 | XOR (* logical xor; p. 243 *)
1435 (* Integer multiplication and division. *)
1437 = IMUL (* signed multiplication (one operand form); p. 114 *)
1438 | MUL (* unsigned multiplication; p. 170 *)
1439 | IDIV (* signed division; p. 112 *)
1440 | DIV (* unsigned division; p. 108 *)
1441 | IMOD (* signed modulus; *)
1442 | MOD (* unsigned modulus; *)
1447 fn IMUL => str "imul"
1449 | IDIV => str "idiv"
1451 | IMOD => str "imod"
1455 (* Integer unary arithmetic/logic instructions. *)
1457 = INC (* increment by 1; p. 117 *)
1458 | DEC (* decrement by 1; p. 106 *)
1459 | NEG (* two's complement negation; p. 172 *)
1460 | NOT (* one's complement negation; p. 175 *)
1471 (* Integer shift/rotate arithmetic/logic instructions. *)
1473 = SAL (* shift arithmetic left; p. 211 *)
1474 | SHL (* shift logical left; p. 211 *)
1475 | SAR (* shift arithmetic right; p. 214 *)
1476 | SHR (* shift logical right; p. 214 *)
1477 | ROL (* rotate left; p. 206 *)
1478 | RCL (* rotate through carry left; p. 197 *)
1479 | ROR (* rotate right; p. 208 *)
1480 | RCR (* rotate through carry right; p. 199 *)
1495 (* Move with extention instructions. *)
1497 = MOVSX (* move with sign extention; p. 167 *)
1498 | MOVZX (* move with zero extention; p. 169 *)
1503 fn MOVSX => str "movs"
1504 | MOVZX => str "movz"
1507 (* Condition test field; p. 340 *)
1509 = O (* overflow *) | NO (* not overflow *)
1510 | B (* below *) | NB (* not below *)
1511 | AE (* above or equal *) | NAE (* not above or equal *)
1512 | C (* carry *) | NC (* not carry *)
1513 | E (* equal *) | NE (* not equal *)
1514 | Z (* zero *) | NZ (* not zero *)
1515 | BE (* below or equal *) | NBE (* not below or equal *)
1516 | A (* above *) | NA (* not above *)
1517 | S (* sign *) | NS (* not sign *)
1518 | P (* parity *) | NP (* not parity *)
1519 | PE (* parity even *) | PO (* parity odd *)
1521 | NL (* not less than *)
1522 | LE (* less than or equal *)
1523 | NLE (* not less than or equal *)
1524 | G (* greater than *)
1525 | NG (* not greater than *)
1526 | GE (* greater than or equal *)
1527 | NGE (* not greater than or equal *)
1529 val condition_negate
1530 = fn O => NO | NO => O
1532 | AE => NAE | NAE => AE
1536 | BE => NBE | NBE => BE
1540 | PE => PO | PO => PE
1542 | LE => NLE | NLE => LE
1544 | GE => NGE | NGE => GE
1546 val condition_reverse
1547 = fn B => A | NB => NA
1548 | AE => BE | NAE => NBE
1550 | BE => AE | NBE => NAE
1553 | LE => GE | NLE => NGE
1555 | GE => LE | NGE => NLE
1561 val rec condition_layout
1578 | c => seq [str "n", condition_layout (condition_negate c)]
1580 val condition_toString = Layout.toString o condition_layout
1583 (* Scalar SSE binary arithmetic instructions. *)
1585 = SSE_ADDS (* addition; p. 7,10 *)
1586 | SSE_SUBS (* subtraction; p. 371,374 *)
1587 | SSE_MULS (* multiplication; p. 201,204 *)
1588 | SSE_DIVS (* division; p. 97,100 *)
1589 | SSE_MAXS (* maximum; p. 128, 130 *)
1590 | SSE_MINS (* minimum; p. 132, 134 *)
1591 val sse_binas_layout
1595 fn SSE_ADDS => str "adds"
1596 | SSE_SUBS => str "subs"
1597 | SSE_MULS => str "muls"
1598 | SSE_DIVS => str "divs"
1599 | SSE_MAXS => str "maxs"
1600 | SSE_MINS => str "mins"
1602 (* Scalar SSE unary arithmetic instructions. *)
1604 = SSE_SQRTS (* square root; p. 360,362 *)
1609 fn SSE_SQRTS => str "sqrts"
1611 (* Packed SSE binary logical instructions (used as scalar). *)
1613 = SSE_ANDNP (* and-not; p. 17,19 *)
1614 | SSE_ANDP (* and; p. 21,23 *)
1615 | SSE_ORP (* or; p. 206,208 *)
1616 | SSE_XORP (* xor; p. 391,393 *)
1617 val sse_binlp_layout
1621 fn SSE_ANDNP => str "andnp"
1622 | SSE_ANDP => str "andp"
1623 | SSE_ORP => str "orp"
1624 | SSE_XORP => str "xorp"
1627 (* amd64 Instructions.
1628 * src operands are not changed by the instruction.
1629 * dst operands are changed by the instruction.
1636 (* Integer binary arithmetic(w/o mult & div)/logic instructions.
1638 | BinAL of {oper: binal,
1642 (* Psuedo integer multiplication and division.
1648 (* Integer multiplication and division.
1653 (* Integer signed/unsiged multiplication (two operand form); p. 335
1655 | IMUL2 of {src: Operand.t,
1658 (* Integer unary arithmetic/logic instructions.
1660 | UnAL of {oper: unal,
1663 (* Integer shift/rotate arithmetic/logic instructions.
1665 | SRAL of {oper: sral,
1669 (* Arithmetic compare.
1671 | CMP of {src1: Operand.t,
1676 | TEST of {src1: Operand.t,
1679 (* Set byte on condition.
1681 | SETcc of {condition: condition,
1686 | JMP of {target: Operand.t,
1688 (* Jump if condition is met.
1690 | Jcc of {condition: condition,
1694 | CALL of {target: Operand.t,
1696 (* Return from procedure.
1698 | RET of {src: Operand.t option}
1701 | MOV of {src: Operand.t,
1704 (* Conditional move.
1706 | CMOVcc of {condition: condition,
1710 (* Exchange register/memory with register.
1712 | XCHG of {src: Operand.t,
1715 (* Pseudo-push a value onto a stack.
1717 | pPUSH of {src: Operand.t,
1720 (* Pseudo-pop a value from a stack.
1722 | pPOP of {dst: Operand.t,
1725 (* Push a value onto the stack.
1727 | PUSH of {src: Operand.t,
1729 (* Pop a value from the stack.
1731 | POP of {dst: Operand.t,
1733 (* Convert X to 2X with sign extension.
1735 | CX of {size: Size.t}
1736 (* Move with extention.
1738 | MOVX of {oper: movx,
1743 (* Move with contraction.
1745 | XVOM of {src: Operand.t,
1749 (* Load effective address.
1751 | LEA of {src: Operand.t,
1754 (* Scalar SSE binary arithmetic instructions.
1756 | SSE_BinAS of {oper: sse_binas,
1760 (* Scalar SSE unary arithmetic instructions.
1762 | SSE_UnAS of {oper: sse_unas,
1766 (* Packed SSE binary logical instructions (used as scalar).
1768 | SSE_BinLP of {oper: sse_binlp,
1772 (* Scalar SSE move instruction.
1774 | SSE_MOVS of {src: Operand.t,
1777 (* Scalar SSE compare instruction.
1779 | SSE_COMIS of {src1: Operand.t,
1782 (* Scalar SSE unordered compare instruction.
1784 | SSE_UCOMIS of {src1: Operand.t,
1787 (* Scalar SSE floating-point/floating-point convert instruction.
1789 | SSE_CVTSFP2SFP of {src: Operand.t,
1793 (* Scalar SSE floating-point/signed-integer convert instruction.
1795 | SSE_CVTSFP2SI of {src: Operand.t,
1799 | SSE_CVTSI2SFP of {src: Operand.t,
1803 (* Scalar SSE move data instruction.
1805 | SSE_MOVD of {src: Operand.t,
1813 fun bin (oper, size, oper1, oper2)
1820 fun un (oper, size, oper1)
1830 | BinAL {oper, src, dst, size}
1831 => bin (binal_layout oper,
1835 | pMD {oper, src, dst, size}
1836 => bin (md_layout oper,
1840 | MD {oper, src, size}
1842 val s = un (md_layout oper,
1847 Size.BYTE => seq [str "movb %dl,%ah", str ";",
1849 str ";", str "movb %ah,%dl"]
1852 | IMUL2 {src, dst, size}
1857 | UnAL {oper, dst, size}
1858 => un (unal_layout oper,
1861 | SRAL {oper, count, dst, size}
1862 => bin (sral_layout oper,
1864 Operand.layout count,
1866 | CMP {src1, src2, size}
1869 Operand.layout src2,
1870 Operand.layout src1)
1871 | TEST {src1, src2, size}
1874 Operand.layout src2,
1875 Operand.layout src1)
1876 | SETcc {condition, dst, ...}
1878 condition_layout condition,
1881 | JMP {target, absolute}
1883 if absolute then str "*" else empty,
1884 Operand.layout target]
1885 | Jcc {condition, target}
1887 condition_layout condition,
1889 Operand.layout target]
1890 | CALL {target, absolute}
1891 => seq [str "call ",
1892 if absolute then str "*" else empty,
1893 Operand.layout target]
1898 | SOME src => seq [str " ", Operand.layout src]]
1899 | MOV {src, dst, size}
1904 | CMOVcc {condition, src, dst, size}
1906 condition_layout condition,
1912 | XCHG {src, dst, size}
1917 | pPUSH {src, base, size}
1918 => seq [str "ppush",
1921 Operand.layout base,
1924 | pPOP {dst, base, size}
1928 Operand.layout base,
1943 of Size.BYTE => str "cbtw ; movb %ah,%dl"
1944 | Size.WORD => str "cwtd"
1945 | Size.LONG => str "cltd"
1946 | Size.QUAD => str "cqto"
1947 | _ => Error.bug "amd64.Instruction.layout: CX,unsupported conversion")
1948 | MOVX {oper, src, srcsize, dst, dstsize}
1950 val (oper, suffix, src, dst) =
1951 case (oper, src, srcsize, dst, dstsize) of
1954 Operand.Register (Register.T {reg, ...}),
1956 (str "mov", str "l",
1959 (Register.T {reg = reg, part = Register.E}))
1962 seq [Size.layout srcsize,
1963 Size.layout dstsize],
1970 | XVOM {src, srcsize, dst, dstsize}
1972 seq [Size.layout srcsize,
1973 Size.layout dstsize],
1976 | LEA {src, dst, size}
1981 | SSE_BinAS {oper, src, dst, size}
1982 => bin (sse_binas_layout oper,
1986 | SSE_UnAS {oper, src, dst, size}
1987 => bin (sse_unas_layout oper,
1991 | SSE_BinLP {oper, src, dst, size}
1992 => bin (sse_binlp_layout oper,
1996 | SSE_MOVS {src, dst, size}
2001 | SSE_COMIS {src1, src2, size}
2002 => bin (str "comis",
2004 Operand.layout src1,
2005 Operand.layout src2)
2006 | SSE_UCOMIS {src1, src2, size}
2007 => bin (str "ucomis",
2009 Operand.layout src1,
2010 Operand.layout src2)
2011 | SSE_CVTSFP2SFP {src, srcsize, dst, dstsize}
2013 seq [str "s", Size.layout srcsize,
2014 str "2", str "s", Size.layout dstsize],
2017 | SSE_CVTSFP2SI {src, srcsize, dst, dstsize, ...}
2019 seq [str "s", Size.layout srcsize,
2023 | Size.QUAD => Size.layout dstsize
2024 | _ => Error.bug "amd64.Instruction.layout: SSE_CVTSFP2SI,unsupported conversion"],
2027 | SSE_CVTSI2SFP {src, srcsize, dst, dstsize, ...}
2030 str "2", str "s", Size.layout dstsize,
2033 | Size.QUAD => Size.layout srcsize
2034 | _ => Error.bug "amd64.Instruction.layout: SSE_CVTSI2SFP,unsupported conversion"],
2037 | SSE_MOVD {src, dst, ...}
2043 val toString = Layout.toString o layout
2047 => {uses = [], defs = [], kills = []}
2049 => {uses = [], defs = [], kills = []}
2050 | BinAL {src, dst, ...}
2051 => {uses = [src, dst], defs = [dst], kills = []}
2052 | pMD {src, dst, ...}
2053 => {uses = [src, dst], defs = [dst], kills = []}
2054 | MD {oper, src, size}
2059 => (Register.T {reg = Register.RDX, part = Register.L},
2060 Register.T {reg = Register.RAX, part = Register.L})
2062 => (Register.T {reg = Register.RDX, part = Register.X},
2063 Register.T {reg = Register.RAX, part = Register.X})
2065 => (Register.T {reg = Register.RDX, part = Register.E},
2066 Register.T {reg = Register.RAX, part = Register.E})
2068 => (Register.T {reg = Register.RDX, part = Register.R},
2069 Register.T {reg = Register.RAX, part = Register.R})
2070 | _ => Error.bug "amd64.Instruction.uses_defs: MD, size"
2072 if oper = IMUL orelse oper = MUL
2073 then {uses = [src, Operand.register lo],
2074 defs = [Operand.register hi, Operand.register lo],
2076 else {uses = [src, Operand.register hi, Operand.register lo],
2077 defs = [Operand.register hi, Operand.register lo],
2080 | IMUL2 {src, dst, ...}
2081 => {uses = [src, dst], defs = [dst], kills = []}
2083 => {uses = [dst], defs = [dst], kills = []}
2084 | SRAL {count, dst, size, ...}
2085 => if isSome (Operand.deMemloc count)
2090 => Register.T {reg = Register.RCX,
2093 => Register.T {reg = Register.RCX,
2096 => Register.T {reg = Register.RCX,
2099 => Register.T {reg = Register.RCX,
2101 | _ => Error.bug "amd64.Instruction.uses_defs: SRAL, size"
2103 {uses = [count, dst, Operand.register reg],
2107 else {uses = [count, dst],
2110 | CMP {src1, src2, ...}
2111 => {uses = [src1, src2], defs = [], kills = []}
2112 | TEST {src1, src2, ...}
2113 => {uses = [src1, src2], defs = [], kills = []}
2115 => {uses = [], defs = [dst], kills = []}
2117 => {uses = [target], defs = [], kills = []}
2119 => {uses = [target], defs = [], kills = []}
2120 | CALL {target, ...}
2121 => {uses = [target], defs = [], kills = []}
2123 => {uses = case src of NONE => [] | SOME src => [src],
2126 | MOV {src, dst, ...}
2127 => {uses = [src], defs = [dst], kills = []}
2128 | CMOVcc {src, dst, ...}
2129 => {uses = [src], defs = [dst], kills = []}
2130 | XCHG {src, dst, ...}
2131 => {uses = [src,dst], defs = [src,dst], kills = []}
2132 | pPUSH {src, base, size, ...}
2133 => {uses = [src,base],
2136 of Operand.MemLoc base
2138 (MemLoc.simple {base = base,
2139 index = Immediate.zero,
2142 class = MemLoc.Class.CStack})]
2145 | pPOP {dst, base, size, ...}
2148 of Operand.MemLoc base
2150 (MemLoc.simple {base = base,
2151 index = Immediate.zero,
2154 class = MemLoc.Class.CStack})]
2159 => {uses = [src, Operand.register Register.rsp],
2160 defs = [Operand.register Register.rsp,
2161 Operand.address (Address.T {disp = NONE,
2162 base = SOME Register.rsp,
2167 => {uses = [Operand.register Register.rsp,
2168 Operand.address (Address.T {disp = NONE,
2169 base = SOME Register.rsp,
2172 defs = [dst, Operand.register Register.rsp],
2179 => (Register.T {reg = Register.RDX, part = Register.L},
2180 Register.T {reg = Register.RAX, part = Register.L})
2182 => (Register.T {reg = Register.RDX, part = Register.X},
2183 Register.T {reg = Register.RAX, part = Register.X})
2185 => (Register.T {reg = Register.RDX, part = Register.E},
2186 Register.T {reg = Register.RAX, part = Register.E})
2188 => (Register.T {reg = Register.RDX, part = Register.R},
2189 Register.T {reg = Register.RAX, part = Register.R})
2190 | _ => Error.bug "amd64.Instruction.uses_defs: CX, size"
2192 {uses = [Operand.register lo],
2193 defs = [Operand.register hi, Operand.register lo],
2196 | MOVX {src, dst, ...}
2197 => {uses = [src], defs = [dst], kills = []}
2198 | XVOM {src, dst, ...}
2199 => {uses = [src], defs = [dst], kills = []}
2200 | LEA {src, dst, ...}
2201 => {uses = [src], defs = [dst], kills = []}
2202 | SSE_BinAS {src, dst, ...}
2203 => {uses = [src, dst], defs = [dst], kills = []}
2204 | SSE_UnAS {src, dst, ...}
2205 => {uses = [src], defs = [dst], kills = []}
2206 | SSE_BinLP {src, dst, ...}
2207 => {uses = [src, dst], defs = [dst], kills = []}
2208 | SSE_MOVS {src, dst, ...}
2209 => {uses = [src], defs = [dst], kills = []}
2210 | SSE_COMIS {src1, src2, ...}
2211 => {uses = [src1, src2], defs = [], kills = []}
2212 | SSE_UCOMIS {src1, src2, ...}
2213 => {uses = [src1, src2], defs = [], kills = []}
2214 | SSE_CVTSFP2SFP {src, dst, ...}
2215 => {uses = [src], defs = [dst], kills = []}
2216 | SSE_CVTSFP2SI {src, dst, ...}
2217 => {uses = [src], defs = [dst], kills = []}
2218 | SSE_CVTSI2SFP {src, dst, ...}
2219 => {uses = [src], defs = [dst], kills = []}
2220 | SSE_MOVD {src, dst, ...}
2221 => {uses = [src], defs = [dst], kills = []}
2224 = fn pMD {dst, size, ...}
2229 => (Register.T {reg = Register.RDX, part = Register.L},
2230 Register.T {reg = Register.RAX, part = Register.L})
2232 => (Register.T {reg = Register.RDX, part = Register.X},
2233 Register.T {reg = Register.RAX, part = Register.X})
2235 => (Register.T {reg = Register.RDX, part = Register.E},
2236 Register.T {reg = Register.RAX, part = Register.E})
2238 => (Register.T {reg = Register.RDX, part = Register.R},
2239 Register.T {reg = Register.RAX, part = Register.R})
2240 | _ => Error.bug "amd64.Instruction.hints: MD, size"
2242 val temp = MemLoc.temp {size = size}
2245 (case Operand.deMemloc dst
2246 of SOME memloc => (memloc, lo)
2247 | NONE => (temp, lo))]
2249 | MD {src, size, ...}
2254 => (Register.T {reg = Register.RDX, part = Register.L},
2255 Register.T {reg = Register.RAX, part = Register.L})
2257 => (Register.T {reg = Register.RDX, part = Register.X},
2258 Register.T {reg = Register.RAX, part = Register.X})
2260 => (Register.T {reg = Register.RDX, part = Register.E},
2261 Register.T {reg = Register.RAX, part = Register.E})
2263 => (Register.T {reg = Register.RDX, part = Register.R},
2264 Register.T {reg = Register.RAX, part = Register.R})
2265 | _ => Error.bug "amd64.Instruction.hints: MD, size"
2267 val temp = MemLoc.temp {size = size}
2270 (case Operand.deMemloc src
2271 of SOME memloc => (memloc, lo)
2272 | NONE => (temp, lo))]
2274 | SRAL {count, size, ...}
2275 => (case Operand.deMemloc count
2281 => Register.T {reg = Register.RCX,
2284 => Register.T {reg = Register.RCX,
2287 => Register.T {reg = Register.RCX,
2290 => Register.T {reg = Register.RCX,
2292 | _ => Error.bug "amd64.Instruction.hints: SRAL, size"
2298 => (case Operand.deMemloc base
2299 of SOME base => [(base,Register.rsp)]
2302 => (case Operand.deMemloc base
2303 of SOME base => [(base,Register.rsp)]
2307 val temp = MemLoc.temp {size = Size.QUAD}
2309 [(temp,Register.rsp)]
2313 val temp = MemLoc.temp {size = Size.QUAD}
2315 [(temp,Register.rsp)]
2321 => {srcs = NONE, dsts = NONE}
2323 => {srcs = NONE, dsts = NONE}
2324 | BinAL {src, dst, ...}
2325 => {srcs = SOME [src, dst], dsts = SOME [dst]}
2326 | pMD {src, dst, ...}
2327 => {srcs = SOME [src, dst], dsts = SOME [dst]}
2328 | MD {oper, src, size, ...}
2333 => (Register.T {reg = Register.RDX, part = Register.L},
2334 Register.T {reg = Register.RAX, part = Register.L})
2336 => (Register.T {reg = Register.RDX, part = Register.X},
2337 Register.T {reg = Register.RAX, part = Register.X})
2339 => (Register.T {reg = Register.RDX, part = Register.E},
2340 Register.T {reg = Register.RAX, part = Register.E})
2342 => (Register.T {reg = Register.RDX, part = Register.R},
2343 Register.T {reg = Register.RAX, part = Register.R})
2344 | _ => Error.bug "amd64.Instruction.srcs_dsts: MD, size"
2346 if oper = IMUL orelse oper = MUL
2347 then {srcs = SOME [src,
2348 Operand.register lo],
2349 dsts = SOME [Operand.register hi,
2350 Operand.register lo]}
2351 else {srcs = SOME [src,
2352 Operand.register hi,
2353 Operand.register lo],
2354 dsts = SOME [Operand.register hi,
2355 Operand.register lo]}
2357 | IMUL2 {src, dst, ...}
2358 => {srcs = SOME [src, dst], dsts = SOME [dst]}
2360 => {srcs = SOME [dst], dsts = SOME [dst]}
2361 | SRAL {count, dst, size, ...}
2362 => if isSome (Operand.deMemloc count)
2367 => Register.T {reg = Register.RCX,
2370 => Register.T {reg = Register.RCX,
2373 => Register.T {reg = Register.RCX,
2376 => Register.T {reg = Register.RCX,
2378 | _ => Error.bug "amd64.Instruction.srcs_dsts: SRAL, size"
2380 {srcs = SOME [count, dst, Operand.register reg],
2383 else {srcs = SOME [count, dst],
2385 | CMP {src1, src2, ...}
2386 => {srcs = SOME [src1, src2], dsts = NONE}
2387 | TEST {src1, src2, ...}
2388 => {srcs = SOME [src1, src2], dsts = NONE}
2390 => {srcs = NONE, dsts = SOME [dst]}
2392 => {srcs = SOME [target], dsts = NONE}
2394 => {srcs = SOME [target], dsts = NONE}
2395 | CALL {target, ...}
2396 => {srcs = SOME [target], dsts = NONE}
2398 => {srcs = case src of NONE => NONE | SOME src => SOME [src],
2400 | MOV {src, dst, ...}
2401 => {srcs = SOME [src], dsts = SOME [dst]}
2402 | CMOVcc {src, dst, ...}
2403 => {srcs = SOME [src], dsts = SOME [dst]}
2404 | XCHG {src, dst, ...}
2405 => {srcs = SOME [src,dst], dsts = SOME [src,dst]}
2406 | pPUSH {src, base, ...}
2407 => {srcs = SOME [src,base], dsts = SOME [base]}
2408 | pPOP {dst, base, ...}
2409 => {srcs = SOME [base], dsts = SOME [dst,base]}
2411 => {srcs = SOME [src, Operand.register Register.rsp],
2412 dsts = SOME [Operand.register Register.rsp]}
2414 => {srcs = SOME [Operand.register Register.rsp],
2415 dsts = SOME [dst, Operand.register Register.rsp]}
2421 => (Register.T {reg = Register.RDX, part = Register.L},
2422 Register.T {reg = Register.RAX, part = Register.L})
2424 => (Register.T {reg = Register.RDX, part = Register.X},
2425 Register.T {reg = Register.RAX, part = Register.X})
2427 => (Register.T {reg = Register.RDX, part = Register.E},
2428 Register.T {reg = Register.RAX, part = Register.E})
2430 => (Register.T {reg = Register.RDX, part = Register.R},
2431 Register.T {reg = Register.RAX, part = Register.R})
2432 | _ => Error.bug "amd64.Instruction.srcs_dsts: CX, size"
2434 {srcs = SOME [Operand.register lo],
2435 dsts = SOME [Operand.register hi, Operand.register lo]}
2437 | MOVX {src, dst, ...}
2438 => {srcs = SOME [src], dsts = SOME [dst]}
2439 | XVOM {src, dst, ...}
2440 => {srcs = SOME [src], dsts = SOME [dst]}
2441 | LEA {src, dst, ...}
2442 => {srcs = SOME [src], dsts = SOME [dst]}
2443 | SSE_BinAS {src, dst, ...}
2444 => {srcs = SOME [src, dst], dsts = SOME [dst]}
2445 | SSE_UnAS {src, dst, ...}
2446 => {srcs = SOME [src], dsts = SOME [dst]}
2447 | SSE_BinLP {src, dst, ...}
2448 => {srcs = SOME [src, dst], dsts = SOME [dst]}
2449 | SSE_MOVS {src, dst, ...}
2450 => {srcs = SOME [src], dsts = SOME [dst]}
2451 | SSE_COMIS {src1, src2, ...}
2452 => {srcs = SOME [src1, src2], dsts = NONE}
2453 | SSE_UCOMIS {src1, src2, ...}
2454 => {srcs = SOME [src1, src2], dsts = NONE}
2455 | SSE_CVTSFP2SFP {src, dst, ...}
2456 => {srcs = SOME [src], dsts = SOME [dst]}
2457 | SSE_CVTSFP2SI {src, dst, ...}
2458 => {srcs = SOME [src], dsts = SOME [dst]}
2459 | SSE_CVTSI2SFP {src, dst, ...}
2460 => {srcs = SOME [src], dsts = SOME [dst]}
2461 | SSE_MOVD {src, dst, ...}
2462 => {srcs = SOME [src], dsts = SOME [dst]}
2464 fun replace replacer
2469 | BinAL {oper, src, dst, size}
2470 => BinAL {oper = oper,
2471 src = replacer {use = true, def = false} src,
2472 dst = replacer {use = true, def = true} dst,
2474 | pMD {oper, src, dst, size}
2475 => pMD {oper = oper,
2476 src = replacer {use = true, def = false} src,
2477 dst = replacer {use = true, def = true} dst,
2479 | MD {oper, src, size}
2481 src = replacer {use = true, def = false} src,
2483 | IMUL2 {src, dst, size}
2484 => IMUL2 {src = replacer {use = true, def = false} src,
2485 dst = replacer {use = true, def = true} dst,
2487 | UnAL {oper, dst, size}
2488 => UnAL {oper = oper,
2489 dst = replacer {use = true, def = true} dst,
2491 | SRAL {oper, count, dst, size}
2492 => SRAL {oper = oper,
2493 count = replacer {use = true, def = false} count,
2494 dst = replacer {use = true, def = true} dst,
2496 | CMP {src1, src2, size}
2497 => CMP {src1 = replacer {use = true, def = false} src1,
2498 src2 = replacer {use = true, def = false} src2,
2500 | TEST {src1, src2, size}
2501 => TEST {src1 = replacer {use = true, def = false} src1,
2502 src2 = replacer {use = true, def = false} src2,
2504 | SETcc {condition, dst, size}
2505 => SETcc {condition = condition,
2506 dst = replacer {use = false, def = true} dst,
2508 | JMP {target, absolute}
2509 => JMP {target = replacer {use = true, def = false} target,
2510 absolute = absolute}
2511 | Jcc {condition, target}
2512 => Jcc {condition = condition,
2513 target = replacer {use = true, def = false} target}
2514 | CALL {target, absolute}
2515 => CALL {target = replacer {use = true, def = false} target,
2516 absolute = absolute}
2519 of NONE => RET {src = NONE}
2521 => RET {src = SOME (replacer {use = true, def = false} src)})
2522 | MOV {src, dst, size}
2523 => MOV {src = replacer {use = true, def = false} src,
2524 dst = replacer {use = false, def = true} dst,
2526 | CMOVcc {condition, src, dst, size}
2527 => CMOVcc {condition = condition,
2528 src = replacer {use = true, def = false} src,
2529 dst = replacer {use = false, def = true} dst,
2531 | XCHG {src, dst, size}
2532 => XCHG {src = replacer {use = true, def = true} src,
2533 dst = replacer {use = true, def = true} dst,
2535 | pPUSH {src, base, size}
2536 => pPUSH {src = replacer {use = true, def = false} src,
2537 base = replacer {use = true, def = true} base,
2539 | pPOP {dst, base, size}
2540 => pPOP {dst = replacer {use = false, def = true} dst,
2541 base = replacer {use = true, def = true} base,
2544 => PUSH {src = replacer {use = true, def = false} src,
2547 => POP {dst = replacer {use = false, def = true} dst,
2551 | MOVX {oper, src, srcsize, dst, dstsize}
2552 => MOVX {oper = oper,
2553 src = replacer {use = true, def = false} src,
2555 dst = replacer {use = false, def = true} dst,
2557 | XVOM {src, srcsize, dst, dstsize}
2558 => XVOM {src = replacer {use = true, def = false} src,
2560 dst = replacer {use = false, def = true} dst,
2562 | LEA {src, dst, size}
2563 => LEA {src = replacer {use = true, def = false} src,
2564 dst = replacer {use = false, def = true} dst,
2566 | SSE_BinAS {oper, src, dst, size}
2567 => SSE_BinAS {oper = oper,
2568 src = replacer {use = true, def = false} src,
2569 dst = replacer {use = true, def = true} dst,
2571 | SSE_UnAS {oper, src, dst, size}
2572 => SSE_UnAS {oper = oper,
2573 src = replacer {use = true, def = false} src,
2574 dst = replacer {use = false, def = true} dst,
2576 | SSE_BinLP {oper, src, dst, size}
2577 => SSE_BinLP {oper = oper,
2578 src = replacer {use = true, def = false} src,
2579 dst = replacer {use = true, def = true} dst,
2581 | SSE_MOVS {src, dst, size}
2582 => SSE_MOVS {src = replacer {use = true, def = false} src,
2583 dst = replacer {use = false, def = true} dst,
2585 | SSE_COMIS {src1, src2, size}
2586 => SSE_COMIS {src1 = replacer {use = true, def = false} src1,
2587 src2 = replacer {use = true, def = false} src2,
2589 | SSE_UCOMIS {src1, src2, size}
2590 => SSE_UCOMIS {src1 = replacer {use = true, def = false} src1,
2591 src2 = replacer {use = true, def = false} src2,
2593 | SSE_CVTSFP2SFP {src, srcsize, dst, dstsize}
2594 => SSE_CVTSFP2SFP {src = replacer {use = true, def = false} src,
2596 dst = replacer {use = false, def = true} dst,
2598 | SSE_CVTSFP2SI {src, srcsize, dst, dstsize}
2599 => SSE_CVTSFP2SI {src = replacer {use = true, def = false} src,
2601 dst = replacer {use = false, def = true} dst,
2603 | SSE_CVTSI2SFP {src, srcsize, dst, dstsize}
2604 => SSE_CVTSI2SFP {src = replacer {use = true, def = false} src,
2606 dst = replacer {use = false, def = true} dst,
2608 | SSE_MOVD {src, srcsize, dst, dstsize}
2609 => SSE_MOVD {src = replacer {use = true, def = false} src,
2611 dst = replacer {use = false, def = true} dst,
2614 val nop = fn () => NOP
2615 val hlt = fn () => HLT
2640 val sse_binas = SSE_BinAS
2641 val sse_unas = SSE_UnAS
2642 val sse_binlp = SSE_BinLP
2643 val sse_movs = SSE_MOVS
2644 val sse_comis = SSE_COMIS
2645 val sse_ucomis = SSE_UCOMIS
2646 val sse_cvtsfp2sfp = SSE_CVTSFP2SFP
2647 val sse_cvtsfp2si = SSE_CVTSFP2SI
2648 val sse_cvtsi2sfp = SSE_CVTSI2SFP
2649 val sse_movd = SSE_MOVD
2652 structure Directive =
2656 val num : int ref = ref 0
2657 datatype t = T of {num : int,
2658 plist: PropertyList.t}
2660 val id = T {num = !num,
2661 plist = PropertyList.new ()}
2666 val plist = fn T {plist, ...} => plist
2671 fn T {num, ...} => seq [str "RegAlloc", Int.layout num]
2673 val toString = Layout.toString o layout
2678 (* Assert that a memloc is in a register with properties;
2679 * used at top of basic blocks to establish passing convention.
2681 = Assume of {assumes: {register: Register.t,
2685 reserve: bool} list}
2686 | XmmAssume of {assumes: {register: XmmRegister.t,
2690 reserve: bool} list}
2691 (* Ensure that memloc is in the register, possibly reserved;
2692 * used at bot of basic blocks to establish passing convention,
2693 * also used before C calls to set-up %rsp.
2695 | Cache of {caches: {register: Register.t,
2697 reserve: bool} list}
2698 | XmmCache of {caches: {register: XmmRegister.t,
2700 reserve: bool} list}
2701 (* Reset the register allocation;
2702 * used at bot of basic blocks that fall-thru
2703 * to a block with multiple incoming paths of control.
2706 (* Ensure that memlocs are commited to memory;
2707 * used at bot of basic blocks to establish passing conventions
2709 | Force of {commit_memlocs: MemLocSet.t,
2710 commit_classes: ClassSet.t,
2711 remove_memlocs: MemLocSet.t,
2712 remove_classes: ClassSet.t,
2713 dead_memlocs: MemLocSet.t,
2714 dead_classes: ClassSet.t}
2716 (* Prepare for a C call; i.e., clear all caller save registers;
2717 * used before C calls.
2720 (* Assert the return value;
2721 * used after C calls.
2723 | Return of {returns: {src: Operand.t, dst: MemLoc.t} list}
2725 (* Assert that the register is not free for the allocator;
2728 | Reserve of {registers: Register.t list}
2729 | XmmReserve of {registers: XmmRegister.t list}
2730 (* Assert that the register is free for the allocator;
2731 * used to free registers at fall-thru;
2732 * also used after C calls to free %rsp.
2734 | Unreserve of {registers : Register.t list}
2735 | XmmUnreserve of {registers : XmmRegister.t list}
2736 (* Save the register allocation in id and
2737 * assert that live are used at this point;
2738 * used at bot of basic blocks to delay establishment
2739 * of passing convention to compensation block
2741 | SaveRegAlloc of {live: MemLocSet.t,
2743 (* Restore the register allocation from id and
2744 * remove anything tracked that is not live;
2745 * used at bot of basic blocks to delay establishment
2746 * of passing convention to compensation block
2748 | RestoreRegAlloc of {live: MemLocSet.t,
2752 = fn Assume {assumes}
2753 => concat["Assume: ",
2758 fn ({register, memloc, sync, reserve, ...}, s)
2759 => concat[MemLoc.toString memloc,
2760 " -> ", Register.toString register,
2761 if reserve then " (reserved)" else "",
2762 if sync then " (sync)" else "",
2765 | XmmAssume {assumes}
2766 => concat["XmmAssume: ",
2771 fn ({register, memloc, sync, reserve, ...}, s)
2772 => concat[MemLoc.toString memloc,
2773 " -> ", XmmRegister.toString register,
2774 if reserve then " (reserved)" else "",
2775 if sync then " (sync)" else "",
2779 => concat["Cache: ",
2784 fn ({register, memloc, reserve}, s)
2785 => concat[MemLoc.toString memloc,
2786 " -> ", Register.toString register,
2787 if reserve then " (reserved)" else "",
2791 => concat["XmmCache: ",
2796 fn ({register, memloc, reserve}, s)
2797 => concat[MemLoc.toString memloc,
2798 " -> ", XmmRegister.toString register,
2799 if reserve then " (reserved)" else "",
2802 | Force {commit_memlocs, commit_classes,
2803 remove_memlocs, remove_classes,
2804 dead_memlocs, dead_classes}
2805 => concat["Force: ",
2811 => concat[MemLoc.toString memloc, " ", s]),
2817 => concat[MemLoc.Class.toString class, " ", s]),
2823 => concat[MemLoc.toString memloc, " ", s]),
2829 => concat[MemLoc.Class.toString class, " ", s]),
2835 => concat[MemLoc.toString memloc, " ", s]),
2841 => concat[MemLoc.Class.toString class, " ", s])]
2847 => concat["Return: ", List.toString (fn {src,dst} =>
2848 concat ["(", Operand.toString src,
2849 ",", MemLoc.toString dst, ")"]) returns]
2850 | Reserve {registers}
2851 => concat["Reserve: ",
2853 List.fold(registers,
2856 => concat[Register.toString register, " ", s])]
2857 | XmmReserve {registers}
2858 => concat["XmmReserve: ",
2860 List.fold(registers,
2863 => concat[XmmRegister.toString register, " ", s])]
2864 | Unreserve {registers}
2865 => concat["Unreserve: ",
2867 List.fold(registers,
2870 => concat[Register.toString register, " ", s])]
2871 | XmmUnreserve {registers}
2872 => concat["XmmUnreserve: ",
2874 List.fold(registers,
2877 => concat[XmmRegister.toString register, " ", s])]
2878 | SaveRegAlloc {live, id}
2879 => concat["SaveRegAlloc: ",
2885 => concat[MemLoc.toString memloc, " ", s]),
2887 | RestoreRegAlloc {live, id}
2888 => concat["RestoreRegAlloc: ",
2894 => concat[MemLoc.toString memloc, " ", s]),
2896 val layout = Layout.str o toString
2899 = fn Assume {assumes}
2902 {uses = [], defs = [], kills = []},
2903 fn ({register, memloc, ...},
2905 => {uses = (Operand.memloc memloc)::uses,
2906 defs = (Operand.register register)::defs,
2908 | XmmAssume {assumes}
2911 {uses = [], defs = [], kills = []},
2912 fn ({register, memloc, ...},
2914 => {uses = (Operand.memloc memloc)::uses,
2915 defs = (Operand.xmmregister register)::defs,
2920 {uses = [], defs = [], kills = []},
2921 fn ({register, memloc, ...},
2923 => {uses = (Operand.memloc memloc)::uses,
2924 defs = (Operand.register register)::defs,
2929 {uses = [], defs = [], kills = []},
2930 fn ({register, memloc, ...},
2932 => {uses = (Operand.memloc memloc)::uses,
2933 defs = (Operand.xmmregister register)::defs,
2935 | Reset => {uses = [], defs = [], kills = []}
2936 | Force {commit_memlocs, remove_memlocs, ...}
2937 => {uses = List.map(MemLocSet.toList commit_memlocs, Operand.memloc) @
2938 List.map(MemLocSet.toList remove_memlocs, Operand.memloc),
2941 | CCall => {uses = [], defs = [], kills = []}
2944 val uses = List.map(returns, fn {src, ...} => src)
2945 val defs = List.map(returns, fn {dst, ...} => Operand.memloc dst)
2947 {uses = uses, defs = defs, kills = []}
2949 | Reserve {...} => {uses = [], defs = [], kills = []}
2950 | XmmReserve {...} => {uses = [], defs = [], kills = []}
2951 | Unreserve {...} => {uses = [], defs = [], kills = []}
2952 | XmmUnreserve {...} => {uses = [], defs = [], kills = []}
2953 | SaveRegAlloc {live, ...}
2954 => {uses = List.map(MemLocSet.toList live, Operand.memloc),
2957 | RestoreRegAlloc {...}
2958 => {uses = [], defs = [], kills = []}
2964 fn {register, memloc, ...}
2965 => (memloc, register))
2968 fun replace replacer
2969 = fn Assume {assumes}
2973 fn {register, memloc, weight, sync, reserve}
2974 => {register = register,
2978 reserve = reserve})}
2979 | XmmAssume {assumes}
2980 => XmmAssume {assumes
2983 fn {register, memloc, weight, sync, reserve}
2984 => {register = register,
2988 reserve = reserve})}
2993 fn {register, memloc, reserve}
2994 => {register = case replacer {use = false, def = true}
2995 (Operand.register register)
2996 of Operand.Register register => register
2997 | _ => Error.bug "amd64.Directive.replace: Cache, register",
2998 memloc = case replacer {use = true, def = false}
2999 (Operand.memloc memloc)
3000 of Operand.MemLoc memloc => memloc
3001 | _ => Error.bug "amd64.Directive.replace: Cache, memloc",
3002 reserve = reserve})}
3007 fn {register, memloc, reserve}
3008 => {register = case replacer {use = false, def = true}
3009 (Operand.xmmregister register)
3010 of Operand.XmmRegister register => register
3011 | _ => Error.bug "amd64.Directive.replace: XmmCache, xmmregister",
3012 memloc = case replacer {use = true, def = false}
3013 (Operand.memloc memloc)
3014 of Operand.MemLoc memloc => memloc
3015 | _ => Error.bug "amd64.Directive.replace: XmmCache, memloc",
3016 reserve = reserve})}
3018 | Force {commit_memlocs, commit_classes,
3019 remove_memlocs, remove_classes,
3020 dead_memlocs, dead_classes}
3021 => Force {commit_memlocs = MemLocSet.map
3025 {use = true, def = false}
3026 (Operand.memloc memloc)
3027 of Operand.MemLoc memloc => memloc
3028 | _ => Error.bug "amd64.Directive.replace: Force, commit_memlocs"),
3029 commit_classes = commit_classes,
3030 remove_memlocs = MemLocSet.map
3034 {use = true, def = false}
3035 (Operand.memloc memloc)
3036 of Operand.MemLoc memloc => memloc
3037 | _ => Error.bug "amd64.Directive.replace: Force, remove_memlocs"),
3038 remove_classes = remove_classes,
3039 dead_memlocs = MemLocSet.map
3043 {use = false, def = false}
3044 (Operand.memloc memloc)
3045 of Operand.MemLoc memloc => memloc
3046 | _ => Error.bug "amd64.Directive.replace: Force, dead_memlocs"),
3047 dead_classes = dead_classes}
3050 => Return {returns = List.map
3051 (returns, fn {src,dst} =>
3054 case replacer {use = true, def = false}
3055 (Operand.memloc dst)
3056 of Operand.MemLoc memloc => memloc
3057 | _ => Error.bug "amd64.Directive.replace: Return, returns"})}
3058 | Reserve {registers} => Reserve {registers = registers}
3059 | XmmReserve {registers} => XmmReserve {registers = registers}
3060 | Unreserve {registers} => Unreserve {registers = registers}
3061 | XmmUnreserve {registers} => XmmUnreserve {registers = registers}
3062 | SaveRegAlloc {live, id} => SaveRegAlloc {live = live, id = id}
3063 | RestoreRegAlloc {live, id} => RestoreRegAlloc {live = live, id = id}
3066 val xmmassume = XmmAssume
3068 val xmmcache = XmmCache
3069 val reset = fn () => Reset
3071 val ccall = fn () => CCall
3073 val reserve = Reserve
3074 val xmmreserve = XmmReserve
3075 val unreserve = Unreserve
3076 val xmmunreserve = XmmUnreserve
3077 val saveregalloc = SaveRegAlloc
3078 val restoreregalloc = RestoreRegAlloc
3081 structure PseudoOp =
3087 | Balign of Immediate.t * Immediate.t option * Immediate.t option
3088 | P2align of Immediate.t * Immediate.t option * Immediate.t option
3089 | Space of Immediate.t * Immediate.t
3090 | Byte of Immediate.t list
3091 | Word of Immediate.t list
3092 | Long of Immediate.t list
3093 | Quad of Immediate.t list
3094 | String of string list
3097 | IndirectSymbol of Label.t
3099 | Comm of Label.t * Immediate.t * Immediate.t option
3105 fn Data => str ".data"
3106 | Text => str ".text"
3108 => str ".section __IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5"
3109 | Balign (i,fill,max)
3110 => seq [str ".balign ",
3113 of (NONE, NONE) => empty
3114 | (SOME fill, NONE) => seq [str ",",
3115 Immediate.layout fill]
3116 | (NONE, SOME max) => seq [str ",,",
3117 Immediate.layout max]
3118 | (SOME fill, SOME max) => seq [str ",",
3119 Immediate.layout fill,
3121 Immediate.layout max]]
3122 | P2align (i,fill,max)
3123 => seq [str ".p2align ",
3126 of (NONE, NONE) => empty
3127 | (SOME fill, NONE) => seq [str ",",
3128 Immediate.layout fill]
3129 | (NONE, SOME max) => seq [str ",,",
3130 Immediate.layout max]
3131 | (SOME fill, SOME max) => seq [str ",",
3132 Immediate.layout fill,
3134 Immediate.layout max]]
3136 => seq [str ".space ",
3141 => seq [str ".byte ",
3142 seq (separate(List.map (bs, Immediate.layout), ","))]
3144 => seq [str ".word ",
3145 seq (separate(List.map (ws, Immediate.layout), ","))]
3147 => seq [str ".long ",
3148 seq (separate(List.map (ls, Immediate.layout), ","))]
3150 => seq [str ".quad ",
3151 seq (separate(List.map (ls, Immediate.layout), ","))]
3153 => seq [str ".ascii ",
3154 seq (separate(List.map
3156 fn s => seq [str "\"",
3157 str (String_escapeASM s),
3161 => seq [str ".globl ",
3164 => (* visibility directive depends on target object file *)
3166 val elf = seq [str ".hidden ", Label.layout l]
3167 val macho = seq [str ".private_extern ", Label.layout l]
3168 val coff = seq [str "/* ", str ".hidden ", Label.layout l, str " */"]
3170 case !Control.Target.os of
3171 MLton.Platform.OS.Cygwin => coff
3172 | MLton.Platform.OS.Darwin => macho
3173 | MLton.Platform.OS.MinGW => coff
3177 => seq [str ".indirect_symbol ",
3180 => seq [str ".local ",
3183 => seq [str ".comm ",
3187 case a of NONE => empty
3188 | SOME i => seq [str ",", Immediate.layout i]]
3190 val toString = Layout.toString o layout
3192 fun replace replacer
3196 => case Operand.deLabel
3197 (replacer {use = true, def = false}
3198 (Operand.label label))
3199 of SOME label => label
3200 | NONE => Error.bug "amd64.PseudoOp.replace.replacerLabel"
3201 val replacerImmediate
3203 => case Operand.deImmediate
3204 (replacer {use = true, def = false}
3205 (Operand.immediate immediate))
3206 of SOME immediate => immediate
3207 | NONE => Error.bug "amd64.PseudoOp.replace.replacerImmediate"
3211 | SymbolStub => SymbolStub
3212 | Balign (i,fill,max) => Balign (replacerImmediate i,
3213 Option.map(fill, replacerImmediate),
3214 Option.map(max, replacerImmediate))
3215 | P2align (i,fill,max) => P2align (replacerImmediate i,
3216 Option.map(fill, replacerImmediate),
3217 Option.map(max, replacerImmediate))
3218 | Space (i,f) => Space (replacerImmediate i, replacerImmediate f)
3219 | Byte bs => Byte (List.map(bs, replacerImmediate))
3220 | Word ws => Word (List.map(ws, replacerImmediate))
3221 | Long ls => Long (List.map(ls, replacerImmediate))
3222 | Quad ls => Quad (List.map(ls, replacerImmediate))
3223 | String ss => String ss
3224 | Global l => Global (replacerLabel l)
3225 | Hidden l => Hidden (replacerLabel l)
3226 | IndirectSymbol l => IndirectSymbol (replacerLabel l)
3227 | Local l => Local (replacerLabel l)
3228 | Comm (l, i, a) => Comm (replacerLabel l,
3229 replacerImmediate i,
3230 Option.map(a, replacerImmediate))
3233 val data = fn () => Data
3234 val text = fn () => Text
3235 val symbol_stub = fn () => SymbolStub
3237 val p2align = P2align
3246 val indirect_symbol = IndirectSymbol
3251 structure Assembly =
3255 | Directive of Directive.t
3256 | PseudoOp of PseudoOp.t
3258 | Instruction of Instruction.t
3264 fn Comment s => seq [str "/* ", str s, str " */"]
3265 | Directive d => seq [str "# directive: ", Directive.layout d]
3266 | PseudoOp p => seq [PseudoOp.layout p]
3267 | Label l => seq [Label.layout l, str ":"]
3268 | Instruction i => seq [str "\t", Instruction.layout i]
3270 val toString = Layout.toString o layout
3273 = fn Comment _ => {uses = [], defs = [], kills = []}
3274 | Directive d => Directive.uses_defs_kills d
3275 | PseudoOp _ => {uses = [], defs = [], kills = []}
3276 | Label _ => {uses = [], defs = [], kills = []}
3277 | Instruction i => Instruction.uses_defs_kills i
3280 = fn Comment _ => []
3281 | Directive d => Directive.hints d
3284 | Instruction i => Instruction.hints i
3286 fun replace replacer
3287 = fn Comment s => Comment s
3288 | Directive d => Directive (Directive.replace replacer d)
3289 | PseudoOp p => PseudoOp (PseudoOp.replace replacer p)
3290 | Label l => Label (case Operand.deLabel
3291 (replacer {use = false, def = true}
3294 | NONE => Error.bug "amd64.Assembly.replace, Label")
3295 | Instruction i => Instruction (Instruction.replace replacer i)
3297 val comment = Comment
3298 val isComment = fn Comment _ => true | _ => false
3299 val directive = Directive
3300 val directive_assume = Directive o Directive.assume
3301 val directive_xmmassume = Directive o Directive.xmmassume
3302 val directive_cache = Directive o Directive.cache
3303 val directive_xmmcache = Directive o Directive.xmmcache
3304 val directive_reset = Directive o Directive.reset
3305 val directive_force = Directive o Directive.force
3306 val directive_ccall = Directive o Directive.ccall
3307 val directive_return = Directive o Directive.return
3308 val directive_reserve = Directive o Directive.reserve
3309 val directive_xmmreserve = Directive o Directive.xmmreserve
3310 val directive_unreserve = Directive o Directive.unreserve
3311 val directive_xmmunreserve = Directive o Directive.xmmunreserve
3312 val directive_saveregalloc = Directive o Directive.saveregalloc
3313 val directive_restoreregalloc = Directive o Directive.restoreregalloc
3314 val pseudoop = PseudoOp
3315 val pseudoop_data = PseudoOp o PseudoOp.data
3316 val pseudoop_text = PseudoOp o PseudoOp.text
3317 val pseudoop_symbol_stub = PseudoOp o PseudoOp.symbol_stub
3318 val pseudoop_balign = PseudoOp o PseudoOp.balign
3319 val pseudoop_p2align = PseudoOp o PseudoOp.p2align
3320 val pseudoop_space = PseudoOp o PseudoOp.space
3321 val pseudoop_byte = PseudoOp o PseudoOp.byte
3322 val pseudoop_word = PseudoOp o PseudoOp.word
3323 val pseudoop_long = PseudoOp o PseudoOp.long
3324 val pseudoop_quad = PseudoOp o PseudoOp.quad
3325 val pseudoop_string = PseudoOp o PseudoOp.string
3326 val pseudoop_global = PseudoOp o PseudoOp.global
3327 val pseudoop_hidden = PseudoOp o PseudoOp.hidden
3328 val pseudoop_indirect_symbol = PseudoOp o PseudoOp.indirect_symbol
3329 val pseudoop_local = PseudoOp o PseudoOp.locall
3330 val pseudoop_comm = PseudoOp o PseudoOp.comm
3332 val instruction = Instruction
3333 val instruction_nop = Instruction o Instruction.nop
3334 val instruction_hlt = Instruction o Instruction.hlt
3335 val instruction_binal = Instruction o Instruction.binal
3336 val instruction_pmd = Instruction o Instruction.pmd
3337 val instruction_md = Instruction o Instruction.md
3338 val instruction_imul2 = Instruction o Instruction.imul2
3339 val instruction_unal = Instruction o Instruction.unal
3340 val instruction_sral = Instruction o Instruction.sral
3341 val instruction_cmp = Instruction o Instruction.cmp
3342 val instruction_test = Instruction o Instruction.test
3343 val instruction_setcc = Instruction o Instruction.setcc
3344 val instruction_jmp = Instruction o Instruction.jmp
3345 val instruction_jcc = Instruction o Instruction.jcc
3346 val instruction_call = Instruction o Instruction.call
3347 val instruction_ret = Instruction o Instruction.ret
3348 val instruction_mov = Instruction o Instruction.mov
3349 val instruction_cmovcc = Instruction o Instruction.cmovcc
3350 val instruction_xchg = Instruction o Instruction.xchg
3351 val instruction_ppush = Instruction o Instruction.ppush
3352 val instruction_ppop = Instruction o Instruction.ppop
3353 val instruction_push = Instruction o Instruction.push
3354 val instruction_pop = Instruction o Instruction.pop
3355 val instruction_cx = Instruction o Instruction.cx
3356 val instruction_movx = Instruction o Instruction.movx
3357 val instruction_xvom = Instruction o Instruction.xvom
3358 val instruction_lea = Instruction o Instruction.lea
3359 val instruction_sse_binas = Instruction o Instruction.sse_binas
3360 val instruction_sse_unas = Instruction o Instruction.sse_unas
3361 val instruction_sse_binlp = Instruction o Instruction.sse_binlp
3362 val instruction_sse_movs = Instruction o Instruction.sse_movs
3363 val instruction_sse_comis = Instruction o Instruction.sse_comis
3364 val instruction_sse_ucomis = Instruction o Instruction.sse_ucomis
3365 val instruction_sse_cvtsfp2sfp = Instruction o Instruction.sse_cvtsfp2sfp
3366 val instruction_sse_cvtsfp2si = Instruction o Instruction.sse_cvtsfp2si
3367 val instruction_sse_cvtsi2sfp = Instruction o Instruction.sse_cvtsi2sfp
3368 val instruction_sse_movd = Instruction o Instruction.sse_movd
3371 structure FrameInfo =
3373 datatype t = T of {size: int,
3374 frameLayoutsIndex: int}
3376 fun toString (T {size, frameLayoutsIndex})
3378 "size = ", Int.toString size, ", ",
3379 "frameLayoutsIndex = ",
3380 Int.toString frameLayoutsIndex, "}"]
3386 = Jump of {label: Label.t}
3387 | Func of {label: Label.t,
3389 | Cont of {label: Label.t,
3391 frameInfo: FrameInfo.t}
3392 | Handler of {frameInfo: FrameInfo.t,
3395 | CReturn of {dsts: (Operand.t * Size.t) vector,
3396 frameInfo: FrameInfo.t option,
3397 func: RepType.t CFunction.t,
3401 = fn Jump {label} => concat ["Jump::",
3402 Label.toString label]
3403 | Func {label, live}
3404 => concat ["Func::",
3405 Label.toString label,
3407 (concat o List.separate)
3411 fn (memloc, l) => (MemLoc.toString memloc)::l),
3414 | Cont {label, live, frameInfo}
3415 => concat ["Cont::",
3416 Label.toString label,
3418 (concat o List.separate)
3422 fn (memloc, l) => (MemLoc.toString memloc)::l),
3425 FrameInfo.toString frameInfo]
3426 | Handler {frameInfo, label, live}
3427 => concat ["Handler::",
3428 Label.toString label,
3430 (concat o List.separate)
3434 fn (memloc, l) => (MemLoc.toString memloc)::l),
3437 FrameInfo.toString frameInfo,
3439 | CReturn {dsts, frameInfo, func, label}
3440 => concat ["CReturn::",
3441 Label.toString label,
3443 Vector.toString (fn (dst,_) => Operand.toString dst) dsts,
3445 (CFunction.Target.toString o CFunction.target) func,
3449 | SOME f => FrameInfo.toString f]
3452 = fn CReturn {dsts, func, ...}
3455 List.map (Operand.cReturnTemps (CFunction.return func),
3456 fn {dst, ...} => Operand.memloc dst)
3459 defs = Vector.toListMap(dsts, fn (dst, _) => dst),
3462 | _ => {uses = [], defs = [], kills = []}
3465 = fn Jump {label, ...} => label
3466 | Func {label, ...} => label
3467 | Cont {label, ...} => label
3468 | Handler {label, ...} => label
3469 | CReturn {label, ...} => label
3472 = fn Func {live, ...} => live
3473 | Cont {live, ...} => live
3474 | Handler {live, ...} => live
3475 | _ => MemLocSet.empty
3479 val isFunc = fn Func _ => true | _ => false
3481 val handler = Handler
3482 val creturn = CReturn
3485 structure Transfer =
3489 datatype 'a t = Word of (WordX.t * 'a) list
3503 fun extract(cases,f)
3505 fun doit [(k,target)] = f (k, target)
3506 | doit _ = Error.bug "amd64.Transfer.Cases.extract"
3509 of Word cases => doit cases
3514 fun doit [] = (0 : int)
3515 | doit ((_,target)::cases) = let
3524 of Word cases => doit cases
3527 fun keepAll(cases, p)
3529 fun doit l = List.keepAll(l, fn (k,target) => p (k,target))
3532 of Word cases => Word(doit cases)
3535 fun forall(cases, f)
3537 fun doit l = List.forall(l, fn (k, target) => f (k, target))
3540 of Word cases => doit cases
3543 fun foreach(cases, f)
3545 fun doit l = List.foreach(l, fn (k, target) => f (k, target))
3548 of Word cases => doit cases
3553 fun doit l = List.map(l, fn (k,target) => (k, f (k, target)))
3556 of Word cases => Word(doit cases)
3559 fun mapToList(cases, f)
3561 fun doit l = List.map(l, fn (k,target) => f (k, target))
3564 of Word cases => doit cases
3569 = Goto of {target: Label.t}
3570 | Iff of {condition: Instruction.condition,
3573 | Switch of {test: Operand.t,
3574 cases: Label.t Cases.t,
3576 | Tail of {target: Label.t,
3578 | NonTail of {target: Label.t,
3581 handler: Label.t option,
3583 | Return of {live: MemLocSet.t}
3584 | Raise of {live: MemLocSet.t}
3585 | CCall of {args: (Operand.t * Size.t) list,
3586 frameInfo: FrameInfo.t option,
3587 func: RepType.t CFunction.t,
3588 return: Label.t option}
3593 Label.toString target]
3594 | Iff {condition, truee, falsee}
3596 Instruction.condition_toString condition,
3598 Label.toString truee,
3600 Label.toString falsee]
3601 | Switch {test, cases, default}
3602 => (concat["SWITCH ",
3603 Operand.toString test]) ^
3604 (concat o Cases.mapToList)
3606 fn (w, target) => concat[" (",
3609 Label.toString target,
3612 Label.toString default])
3613 | Tail {target, live}
3615 Label.toString target,
3617 (concat o List.separate)
3621 fn (memloc, l) => (MemLoc.toString memloc)::l),
3624 | NonTail {target, live, return, handler, size}
3625 => concat ["NONTAIL ",
3626 Label.toString target,
3628 (concat o List.separate)
3632 fn (memloc, l) => (MemLoc.toString memloc)::l),
3635 Label.toString return,
3640 of SOME handler => Label.toString handler
3644 => concat ["RETURN",
3646 (concat o List.separate)
3650 fn (memloc, l) => (MemLoc.toString memloc)::l),
3656 (concat o List.separate)
3660 fn (memloc, l) => (MemLoc.toString memloc)::l),
3663 | CCall {args, func, return, ...}
3664 => concat ["CCALL ",
3665 (CFunction.Convention.toString o CFunction.convention) func,
3667 (CFunction.Target.toString o CFunction.target) func,
3669 (concat o List.separate)
3670 (List.map(args, fn (oper,_) => Operand.toString oper),
3673 Option.toString Label.toString return,
3677 = fn Switch {test, ...}
3678 => {uses = [test], defs = [], kills = []}
3679 | CCall {args, func, ...}
3682 List.map (Operand.cReturnTemps (CFunction.return func),
3683 fn {dst, ...} => Operand.memloc dst)
3685 {uses = List.map(args, fn (oper,_) => oper),
3686 defs = defs, kills = []}
3688 | _ => {uses = [], defs = [], kills = []}
3691 = fn Goto {target} => [target]
3692 | Iff {truee,falsee,...} => [truee,falsee]
3693 | Switch {cases,default,...}
3694 => default::(Cases.mapToList
3696 fn (_,target) => target))
3697 | NonTail {return,handler,...} => return::(case handler
3699 | SOME handler => [handler])
3700 | CCall {return, ...}
3707 = fn Tail {live,...} => live
3708 | NonTail {live,...} => live
3709 | Return {live,...} => live
3710 | Raise {live,...} => live
3711 | _ => MemLocSet.empty
3713 fun replace replacer
3714 = fn Switch {test, cases, default}
3715 => Switch {test = replacer {use = true, def = false} test,
3718 | CCall {args, frameInfo, func, return}
3719 => CCall {args = List.map(args,
3720 fn (oper,size) => (replacer {use = true,
3724 frameInfo = frameInfo,
3727 | transfer => transfer
3733 val nontail = NonTail
3739 structure ProfileLabel =
3745 val label = Label.fromString (toString pl)
3747 [Assembly.pseudoop_global label,
3748 Assembly.pseudoop_hidden label,
3749 Assembly.label label]
3751 fun toAssemblyOpt pl =
3754 | SOME pl => toAssembly pl
3759 datatype t' = T' of {entry: Entry.t option,
3760 profileLabel: ProfileLabel.t option,
3761 statements: Assembly.t list,
3762 transfer: Transfer.t option}
3763 fun mkBlock' {entry, statements, transfer} =
3765 profileLabel = NONE,
3766 statements = statements,
3767 transfer = transfer}
3768 fun mkProfileBlock' {profileLabel} =
3770 profileLabel = SOME profileLabel,
3774 datatype t = T of {entry: Entry.t,
3775 profileLabel: ProfileLabel.t option,
3776 statements: Assembly.t list,
3777 transfer: Transfer.t}
3779 fun printBlock (T {entry, profileLabel, statements, transfer, ...})
3780 = (print (Entry.toString entry);
3783 (profileLabel, fn profileLabel =>
3784 (print (ProfileLabel.toString profileLabel);
3787 (statements, fn asm =>
3788 (print (Assembly.toString asm);
3790 print (Transfer.toString transfer);
3793 fun printBlock' (T' {entry, profileLabel, statements, transfer, ...})
3794 = (print (if isSome entry
3795 then Entry.toString (valOf entry)
3799 (profileLabel, fn profileLabel =>
3800 (print (ProfileLabel.toString profileLabel);
3803 (statements, fn asm =>
3804 (print (Assembly.toString asm);
3806 print (if isSome transfer
3807 then Transfer.toString (valOf transfer)
3811 val compress': t' list -> t' list =
3815 fn (b' as T' {entry, profileLabel, statements, transfer}, ac) =>
3820 [] => Error.bug "amd64.Block.compress': dangling transfer"
3823 val T' {entry = entry2,
3824 profileLabel = profileLabel2,
3825 statements = statements2,
3826 transfer = transfer2} = b2'
3830 Error.bug "amd64.Block.compress': mismatched transfer"
3834 case (profileLabel, statements) of
3836 (profileLabel2, statements2)
3840 @ (ProfileLabel.toAssemblyOpt
3847 transfer = transfer2} :: ac
3851 val compress: t' list -> t list =
3854 (compress' l, fn T' {entry, profileLabel, statements, transfer} =>
3855 case (entry, transfer) of
3858 profileLabel = profileLabel,
3859 statements = statements,
3861 | _ => Error.bug "amd64.Block.compress")
3866 datatype t = T of {data: Assembly.t list,
3867 blocks: Block.t list}