Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] View of /trunk/src/compiler/codegen/codegen-fn.sml
ViewVC logotype

View of /trunk/src/compiler/codegen/codegen-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 511 - (download) (annotate)
Tue Feb 8 17:01:43 2011 UTC (8 years, 5 months ago) by jhr
File size: 5364 byte(s)
  Backporting changes from pure-cfg branch.  These include the "actor" ==> "strand"
  changes.
(* codegen-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Generic support for translating LowIL code to the target representation.  We
 * assume that the LowIL has first been run through the splitting pass to match
 * the target's vector widths.
 *)

functor CodeGenFn (T : TARGET) : sig

    val generate : LowIL.program -> T.program

  end = struct

    structure Src = LowIL
    structure SrcV = LowIL.Var
    structure SrcOp = LowOps
    structure SrcNd = LowIL.Node

  (* a property marking nodes that are directly referenced by statememts. *)
    local
      val {getFn, setFn, ...} = SrcNd.newFlag ()
    in
    val isFirst = getFn
    fun markFirst nd = setFn(nd, true)
    end

  (* walk the statements, marking the first nodes of the statements *)
    fun markNodes (stm as SrcIL.STM{kind, next}) = (
	  case kind
	   of SrcIL.S_SIMPLE nd => markFirst (nd, stm)
	    | SrcIL.S_IF{cond, thenBranch, elseBranch} => (
		markFirst (cond, stm);
		markNodes thenBranch;
		markNodes elseBranch)
	    | SrcIL.S_LOOP{hdr, cond, body} => (
		markNodes hdr;
		markFirst (cond, stm);
		markNodes body)
	  (* end case *);
	  case next
	   of NONE => ()
	    | SOME stm => markNodes stm
	  (* end case *))

  (* a mapping from LowIL variables to target expressions.  Variables get
   * removed when the expressions are used as arguments.
   *)
    structure VDefTbl : sig
	type tbl

	val newTbl : unit -> tbl
	val getDefOf : tbl -> SrcV.var -> T.exp
	val useDefOf : tbl -> SrcV.var -> T.exp
	val setDefOf : tbl -> (SrcV.var * T.exp) -> unit

	val clear : tbl -> unit

	val bind : tbl -> (SrcV.var * T.exp) -> T.stm list

      (* force all pending expressions into variables *)
	val flush : tbl -> T.stm list

      end = struct

	type info = {
	    cnt : int ref,	(* count of oustanding uses (usually 1) *)
	    bind : T.exp
	  }

	type tbl = info SrcV.Tbl.hash_table

	fun newTbl () = SrcV.Tbl.mkTable (512, Fail "vtbl")

	fun getDefOf tbl x = (case SrcV.Tbl.find tbl x
	       of NONE => ??
		| SOME{bind, cnt} => bind
	      (* end case *))

	fun useDefOf tbl x = (case SrcV.Tbl.find tbl x
	       of NONE => ??
		| SOME{cnt=ref n, bind} => (
		    ignore (SrcV.Tbl.remove tbl x);
		    bind)
		| SOME{cnt, bind} =>  => (
		    cnt := !cnt - 1;
		    bind)
	      (* end case *))

	fun setDefOf tbl (x, exp) =
	      SrcV.Tbl.insert tbl (x, {cnt = ref(SrcV.useCount x), bind = exp})

	fun assign tbl (x, exp) = let
		    val lhs : T.local_var = ??
		    in
		      SrcV.Tbl.insert tbl
			(x, {cnt = SrcV.useCount x, bind = T.Expr.var lhs});
		      [T.Stmt.assign(lhs, exp)]
		    end

	fun bind tbl (x, exp) = (case SrcV.useCount lhs
	       of 1 => (SrcV.Tbl.insert tbl (x, {cnt = 1, bind = exp}); [])
		| n => let (* bind exp to a new target variable *)
		    val lhs : T.local_var = ??
		    in
		      SrcV.Tbl.insert tbl (x, {cnt = n, bind = T.Expr.var lhs});
		      [T.Stmt.assign(lhs, exp)]
		    end
	      (* end case *))

      end (*  VDefTbl *)

(* FIXME: what about splitting code where the target width doesn't match the
 * source width?
 *)
    fun doRator (vtbl, lhs, rator, args) = let
	  val args' = List.map (VDefTbl.useDefOf vtbl) args
	  val rhs' = (case rator
(* ??? *)
		(* end case *))
	  in
	    VDefTbl.bind vtbl (lhs, rhs')
	  end

  (* translate a LowIL assignment to a list of zero or more target statements *)
    fun doAssign vtbl (lhs, rhs) = let
	  fun setDef rhs = (VTbl.setDefOf vtbl (lhs, rhs); [])
	  in
	    case rhs
	     of Src.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))
	      | Src.LIT(Literal.Int n) => setDef (T.Expr.intLit n)
	      | Src.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)
	      | Src.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)
	      | Src.LIT(Literal.String s) => setDef (T.Expr.stringLit s)
	      | Src.OP(rator, args) => doRator(vtbl, lhs, rator, args)
	      | Src.CONS args =>
		  VTbl.assign ctbl (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))
	    (* end case *)
	  end

    fun gen (vtbl, stm) = let
	  val doAssign = doAssign vtbl
	  fun mkBlock [] = ?
	    | mkBlock [s] = s
	    | mkBlock stms = T.Stmt.block stms
	  fun doStmt (SrcIL.STM{kind, next, ...}) = let
		val stms = (case kind
		       of SrcIL.S_SIMPLE nd => doNode nd
			| SrcIL.S_IF{cond, thenBranch, elseBranch} => let
			    val SrcIL.ND{kind=SrcIL.COND{cond, ...}, ...} = cond
			    val s1 = mkBlock(doStmt thenBranch)
			    val s2 = mkBlock(doStmt elseBranch)
			    in
(* FIXME: check for empty else branch *)
			      T.ifthenelse(VDefTbl.useDefOf vtbl cond, s1, s2)
			    end
			| SrcIL.S_LOOP{hdr, cond, body} => raise Fail "LOOP not supported yet"
		      (* end case *))
		val rest = (case next
		       of NONE => VDefTbl.flush vtbl
			| SOME stm = doStmt stm
		      (* end case *))
		in
		  stms @ rest
		end
	  and doNode (SrcIL.ND{kind, ...}) = (case kind
		 of SrcIL.NULL => ??
		  | SrcIL.ENTRY{succ} => nextNode succ
		  | SrcIL.JOIN{succ, ...} =>
		  | SrcIL.COND{cond, ...} =>
		  | SrcIL.BLOCK{body, succ, ...} =>
		      List.app doAssign body @ nextNode succ
		  | SrcIL.NEW{strand, args, ...} =>
		  | SrcIL.DIE _ =>
		  | SrcIL.STABILIZE _ =>
		  | SrcIL.EXIT _ =>
		(* end case *))
	  and nextNode nd = if isFirst nd then [] else doNode nd
	  in
	    mkBlock (doStmt stm)
	  end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0