Add strings to type system and parser/lexer

[snipe.git] / codegen / liveness.sml

(* L3 Compiler
 * Turns pseudoasm into liveness-annotated pseudoasm
 * Author: Chris Lu <czl@andrew.cmu.edu>
 * Author: Joshua Wise <jwise@andrew.cmu.edu>
 *)

signature LIVENESS =
sig
  structure OperSet : ORD_SET
    where type Key.ord_key = Blarg.oper;
  structure LiveMap : ORD_MAP
    where type Key.ord_key = int;

  type live = int * OperSet.set
  type pseudoasm = Blarg.insn list
  type livenesses = OperSet.set LiveMap.map
  
  type ident = int
  datatype pred = DEF of Blarg.oper | USE of Blarg.oper | SUCC of ident | ISMOVE
  
  type predicates = pred list LiveMap.map

  val uses : pred list -> Blarg.oper list
  val succs : pred list -> ident list
  val defs : pred list -> Blarg.oper list
  val ismove : pred list -> bool

  val liveness : pseudoasm -> predicates * livenesses
  val listify : livenesses -> OperSet.set list
  val prettyprint : OperSet.set -> string
end

structure Liveness :> LIVENESS =
struct
  structure T = Temp
  structure X = Blarg
  
  structure OperSet = Blarg.OperSet
  structure LiveMap = Blarg.LiveMap
  structure LabelMap = SplayMapFn(struct
                                    type ord_key = Label.label
                                    val compare = Label.compare
                                  end)

  type live = int * OperSet.set
  type pseudoasm = X.insn list
  type numasm = X.insn LiveMap.map
  type livenesses = OperSet.set LiveMap.map

  type ident = int
  datatype pred = DEF of X.oper | USE of X.oper | SUCC of ident | ISMOVE

  type predicates = pred list LiveMap.map

  (* val number : pseudoasm -> numasm
   * numbers the instructions!
   *)

  fun number instrs =
    let
      val nums = List.tabulate (List.length instrs, (fn i => i))
    in
      foldr
        LiveMap.insert'
        LiveMap.empty
        (ListPair.zip (nums,instrs))
    end

  (* val defusesucc : numasm -> (ident * pred list) list
   * generates def/use/succ predicates according to rules
   *)
  fun defusesucc l =
    let
      val labelmap = LiveMap.foldri
        (fn (n, a, b) => LabelMap.insert(b, a, n))
        (LabelMap.empty)
        (LiveMap.mapPartial (fn (X.LABEL lb) => SOME(lb) | _ => NONE) l)

      fun findlabel (lb) = valOf (LabelMap.find (labelmap, lb))

      (* val defhit/usehit : X.oper -> pred list
       * helper functions to discard constant operands *)
      fun defhit (X.REG X.PC) = raise ErrorMsg.InternalError "cannot define PC"
        | defhit (X.REG a) = [DEF(X.REG a)]
        | defhit (X.TEMP a) = [DEF(X.TEMP a)]
        | defhit (_) = nil
    
      and usehit (X.REG a) = [USE(X.REG a)]
        | usehit (X.TEMP a) = [USE(X.TEMP a)]
        | usehit (_) = nil

      fun callhit 0 = nil
        | callhit 1 = USE(X.REG(X.R0))::(callhit 0)
        | callhit 2 = USE(X.REG(X.R1))::(callhit 1)
        | callhit 3 = USE(X.REG(X.R2))::(callhit 2)
        | callhit 4 = USE(X.REG(X.R3))::(callhit 3)
        | callhit _ = callhit 4

      (* val gendef : ident * X.insn -> ident * pred list
       * generates the def/use/succ predicates for a single insn
       *)
      fun gendef (n, X.DIRECTIVE(_))           = ([SUCC (n+1)])
        | gendef (n, X.COMMENT(_))             = ([SUCC (n+1)])
        | gendef (n, X.LIVEIGN (_))            = ([SUCC (n+1)])
        | gendef (n, X.LABEL l)                = ([SUCC (n+1)])
        | gendef (n, X.INSN(X.NV, _))          = ([SUCC (n+1)])
        | gendef (n, X.INSN(_, X.MOVLIT(dest, _))) = (defhit dest @ [SUCC(n+1), ISMOVE])
        | gendef (n, X.INSN(_, X.MOVSYM(dest, sym))) = (defhit dest @ [SUCC(n+1), ISMOVE])
        | gendef (n, X.INSN(X.AL, X.MOVLBL(X.REG X.PC, l))) = ([SUCC (findlabel l)])
        | gendef (n, X.INSN(_, X.MOVLBL(X.REG X.PC, l))) = ([SUCC (n+1), SUCC (findlabel l)])
        | gendef (n, X.INSN(_, X.MOVLBL(_, _))) = raise ErrorMsg.InternalError "MOVLBL with target neq PC"
        | gendef (n, X.INSN(_, X.LDR(dest, src))) = (defhit dest @ usehit src @ [SUCC (n+1), ISMOVE])
        | gendef (n, X.INSN(_, X.STO(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.MOV(dest, src))) = (defhit dest @ usehit src @ [SUCC (n+1), ISMOVE])
        | gendef (n, X.INSN(_, X.MOVS(dest, src))) = (usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.ADD(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.ADDS(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.SUB(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.SUBS(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.AND(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.ANDS(dest, src))) = (usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.NOT(dest, src))) = (defhit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.NOTS(dest, src))) = (usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.PUSH(X.REG X.SP, src))) = (usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.PUSH(_, _))) = raise ErrorMsg.InternalError "PUSH with sp != SP"
        | gendef (n, X.INSN(X.AL, X.POP(X.REG X.SP, X.REG X.PC))) = ([USE (X.REG X.R0)]) (* kind of like 'ret' *)
        | gendef (n, X.INSN(_, X.POP(X.REG X.SP, X.REG X.PC))) = ([USE (X.REG X.R0), SUCC(n+1)])
        | gendef (n, X.INSN(_, X.POP(X.REG X.SP, src))) = (defhit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.POP(_, _))) = raise ErrorMsg.InternalError "POP with sp != SP"
        | gendef (n, X.INSN(_, X.CALL(X.REG X.SP, src, a))) = (callhit a @
                                                               usehit src @
                                                               [DEF(X.REG(X.R0)), DEF(X.REG(X.R1)), DEF(X.REG(X.R2)), DEF(X.REG(X.R3)),
                                                                DEF(X.REG(X.R4)), DEF(X.REG(X.R5)),
                                                                SUCC(n+1)]
                                                              )
        | gendef (n, X.INSN(_, X.CALL(_, _, _))) = raise ErrorMsg.InternalError "CALL with sp != SP"
        | gendef (n, X.INSN(_, X.SHR(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)])
        | gendef (n, X.INSN(_, X.SHL(dest, src))) = (defhit dest @ usehit dest @ usehit src @ [SUCC (n+1)])
    in
        LiveMap.mapi gendef l
    end

  (* val uselive : (int * pred list) list -> OperSet.set LiveMap.map
   * generates liveness for 'use' rules to get the iterative analyzer started
   *)
  fun uselive preds =
    LiveMap.mapi
      (fn (n, pl) =>
         foldr
           (fn (USE (l), set) => OperSet.add (set, l)
             | (_, set) => set)
           OperSet.empty
           pl
      )
      preds

  (* val subsetlive : OperSet.set LiveMap.map * OperSet.set LiveMap.map -> bool
   * true if first is subset of second
   *)

  fun subsetlive (l1,l2) =
    LiveMap.foldri
      (fn (_, _, false) => false
        | (n, set1, _) => case LiveMap.find (l2, n)
            of NONE => false
             | SOME set2 => OperSet.isSubset (set1, set2))
      true
      l1
  
  (* val succs : pred list -> int list
   * generates a list of lines that succeed a line given the predicates
   * for that line
   *)
  fun succs (SUCC(a)::l') = a::(succs l')
    | succs (_::l') = succs l'
    | succs nil = nil

  fun defs (DEF(a)::l) = a::(defs l)
    | defs (_::l) = defs l
    | defs nil = nil
  
  fun uses (USE(a)::l) = a::(defs l)
    | uses (_::l) = defs l
    | uses nil = nil
  
  fun ismove l = List.exists (fn ISMOVE => true | _ => false) l

  (* val liveiter : OperSet.set LiveMap.map -> (int * pred list) list -> OperSet.set LiveMap.map
   * 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 :
   *
   *    use(l',x)
   *   !def(l,x)
   *   succ(l,l')
   * --------------
   *   live(l,x)
   *)

  fun liveiter livemap preds =
    let



      (* val lives : int list -> OperSet.set LiveMap.map -> OperSet.set
       * scans l for live variables in succeeding lines *)
      fun lives l' idents =
        let
          val lines = List.mapPartial (fn a => LiveMap.find (l', a)) idents
        in
          foldr
            (fn (set', set) => OperSet.union (set', set))
            OperSet.empty
            lines
        end

      (* val isndef : X.oper -> pred list -> bool
       * checks to see if x is defined in a predicate list *)
      fun isndef (X.STACKARG(_)) _ = false
        | isndef x (DEF(y)::l') = not (X.opereq (x,y)) andalso isndef x l'
        | isndef x (a::l') = isndef x l'
        | isndef x nil = true

      (* val liveadd : live -> OperSet.set LiveMap.map -> OperSet.set LiveMap.map *)
      fun liveadd (n,oper) map = case LiveMap.find (map, n)
        of SOME(x) => LiveMap.insert (map, n, OperSet.add (x, oper))
         | NONE => LiveMap.insert (map, n, OperSet.singleton oper)

      (* this does the dirty work!
       * for each line, checks if the live variables in succeeding lines are
       * not defined here; if so, it accumulates them onto the inital list
       *
       * changing the first foldr to a foldl slows down liveness by a factor
       * of at least 100 on cedar-anastulate.l2
       *)
      val newl = LiveMap.foldri
        (fn (n, a, b) => OperSet.foldr
          (fn (a',b') => if (isndef a' a) then liveadd (n, a') b' else b')
          b
          (lives b (succs a))
        )
        livemap
        preds
    in
      if subsetlive (newl, livemap)
      then livemap
      else liveiter newl preds
    end

  fun dustostring (DEF(a)) = "DEF(" ^ X.pp_oper a ^ ")"
    | dustostring (USE(a)) = "USE(" ^ X.pp_oper a ^ ")"
    | dustostring (SUCC(a)) = "SUCC(" ^ Int.toString a ^ ")"
    | dustostring ISMOVE = "ISMOVE"

  (* val liveness : pseudoasm -> livenesses
   * analyzes liveness of variables in the given pseudo-asm
   *)

  fun liveness instrs =
    let
      val preds = defusesucc (number instrs)
(*      val (_,l) = ListPair.unzip preds
      val () = print (
        String.concatWith "\n" (
          List.map
            (fn a => String.concatWith ", " (List.map dustostring a))
            l
        )
      )*)
      val init = uselive preds
      val initmap = LiveMap.foldri (fn (n,a,b) => LiveMap.insert (b, n, a)) LiveMap.empty init
    in
      (preds, liveiter initmap preds)
    end
  
  fun prettyprint (set) =
    OperSet.foldr
      (fn (oper, s) => (X.pp_oper oper) ^ ", " ^ s)
      "-\n"
      set
      
  fun listify map =
    let
      val maxln = LiveMap.foldri (fn (a, _, b) => Int.max (a, b)) 0 map
      val nums = List.tabulate (maxln+1, fn x => x)
    in
      List.map (fn num => valOf (LiveMap.find (map, num)) handle Option => OperSet.empty) nums
    end
end