+
+ type live = int * x86.oper list
+ type pseudoasm = X.insn list
+ type numasm = (int * X.insn) list
+ type livenesses = X.oper list list
+
+ type ident = int
+ datatype pred = DEF of X.oper | USE of X.oper | SUCC of ident
+
+ (* val number : pseudoasm -> numasm
+ * numbers the instructions!
+ *)
+
+ fun number instrs =
+ let
+ val nums = List.tabulate (List.length instrs, (fn i => i))
+ in
+ ListPair.zip (nums,instrs)
+ end
+
+ (* val defusesucc : numasm -> (ident * pred list) list
+ * generates def/use/succ predicates according to rules
+ *)
+
+ fun defusesucc l =
+ let
+ fun findlabel (lb) =
+ Option.valOf
+ (foldr (fn ((n, X.LABEL lb'), NONE) => if (Label.compare (lb, lb') = EQUAL) then SOME n else NONE
+ | (_, old) => old) NONE l)
+
+ (* val defhit/usehit : X.oper -> pred list
+ * helper functions to discard constant operands *)
+ fun defhit (a as X.CONST(_)) = nil
+ | defhit (a) = [DEF(a)]
+
+ fun usehit (a as X.CONST(_)) = nil
+ | usehit (a) = [USE(a)]
+
+ (* val gendef : ident * X.insn -> ident * pred list
+ * generates the def/use/succ predicates for a single insn
+ *)
+ fun gendef (n, X.DIRECTIVE(_)) = (n, nil)
+ | gendef (n, X.COMMENT(_)) = (n, nil)
+ | gendef (n, X.MOVL(dest, src)) = (n, defhit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.SUBL(dest, src)) = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.IMUL(dest, src)) = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.IMUL3(dest, src, _)) = (n, defhit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.ADDL(dest, src)) = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.IDIVL(src)) = (n, usehit src @ [DEF(X.REG(X.EAX)), DEF(X.REG(X.EDX)),
+ USE(X.REG(X.EAX)), USE(X.REG(X.EDX)),
+ SUCC(n+1)])
+ | gendef (n, X.CLTD) = (n, [USE(X.REG(X.EAX)), DEF(X.REG(X.EDX)), SUCC(n+1)])
+ | gendef (n, X.SALL(dest, shft)) = (n, defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)])
+ | gendef (n, X.SARL(dest, shft)) = (n, defhit dest @ usehit shft @ usehit dest @ [SUCC(n+1)])
+ | gendef (n, X.NEG(src)) = (n, defhit src @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.NOTL(src)) = (n, defhit src @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.ANDL(dest, src)) = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.ORL(dest, src)) = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.XORL(dest, src)) = (n, defhit dest @ usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.CMPL(dest, src)) = (n, usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.TEST(dest, src)) = (n, usehit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.SETNE(dest)) = (n, defhit dest @ [SUCC(n+1)])
+ | gendef (n, X.SETE(dest)) = (n, defhit dest @ [SUCC(n+1)])
+ | gendef (n, X.SETLE(dest)) = (n, defhit dest @ [SUCC(n+1)])
+ | gendef (n, X.SETL(dest)) = (n, defhit dest @ [SUCC(n+1)])
+ | gendef (n, X.SETGE(dest)) = (n, defhit dest @ [SUCC(n+1)])
+ | gendef (n, X.SETG(dest)) = (n, defhit dest @ [SUCC(n+1)])
+ | gendef (n, X.MOVZBL(dest, src)) = (n, defhit dest @ usehit src @ [SUCC(n+1)])
+ | gendef (n, X.RET) = (n, nil)
+ | gendef (n, X.LABEL l) = (n, [SUCC (n+1)])
+ | gendef (n, X.JMP l) = (n, [SUCC (findlabel l)])
+ | gendef (n, X.JE l) = (n, [SUCC (n+1), SUCC (findlabel l)])
+ | gendef (n, X.JNE l) = (n, [SUCC (n+1), SUCC (findlabel l)])
+ in
+ List.map gendef l
+ end
+
+ (* val uselive : (ident * pred list) list -> live list
+ * generates liveness for 'use' rules to get the iterative analyzer started
+ *)
+ fun uselive preds =
+ List.map
+ (fn (n, l) => (n, List.foldr
+ (fn (a,b) => case a of USE(x) => x::b | _ => b)
+ nil
+ l
+ )
+ )
+ preds
+
+ (* val subsetlive : (ident * pred list) * (ident * pred list) -> bool
+ * true if first is subset of second
+ *)
+
+ fun subsetlive (l1,l2) =
+ ListPair.all
+ (fn ((n1,a),(n2,b)) => (n1 = n2) andalso List.all
+ (fn x => List.exists (fn y => X.opereq (x,y)) b)
+ a
+ )
+ (l1,l2)
+
+ (* val liveiter : live list -> (ident * pred list) list -> live list
+ * iteratively generates livenesses from def/use/succ rules
+ * it must be fed a liveness list generated from the use rule as it only
+ * processes the second rule :