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

SCM Repository

[diderot] View of /branches/vis15/src/compiler/target-cpu/gen-world.sml
ViewVC logotype

View of /branches/vis15/src/compiler/target-cpu/gen-world.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3927 - (download) (annotate)
Sat Jun 4 21:20:01 2016 UTC (3 years, 1 month ago) by jhr
File size: 7098 byte(s)
working on merge: code generation
(* gen-world.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *)

structure GenWorld : sig

    val genStruct : TargetSpec.t * Atom.atom * int -> CLang.decl

    val genInitiallyFun : CodeGenEnv.t * Atom.atom * TreeIR.create -> CLang.decl

  end = struct

    structure CL = CLang
    structure RN = CxxNames
    structure Env = CodeGenEnv
    structure Util = CodeGenUtil
    structure ToCxx = TreeToCxx

  (* generate the struct declaration for the world representation *)
    fun genStruct (spec : TargetSpec.t, strandName, nAxes) = let
	  fun memberVar (ty, name) = CL.D_Var([], ty, name, NONE)
	  val members = []
	  val statePtrTy = CL.T_Ptr(CL.T_Named(Atom.toString strandName ^ "_strand"))
	  val members = if TargetSpec.dualState spec
		then memberVar(statePtrTy, "_outState") ::
		  memberVar(statePtrTy, "_inState") :: members
		else memberVar(statePtrTy, "_state") :: members
	  val members = memberVar(CL.T_Ptr CL.uint8, "_status") :: members
	  val members = if #hasGlobals spec
		then memberVar(RN.globalPtrTy, "_globals") :: members
		else members
	  val members = if #exec spec orelse not(#hasInputs spec)
		then members
		else memberVar(CL.T_Named "inputs", "_definedInp") :: members
	  val members = if TargetSpec.isParallel spec
		then memberVar(CL.T_Ptr(CL.T_Named "sched_info"), "_sched") :: members
		else memberVar(CL.T_Named "uint32_t", "_nactive") ::
		  memberVar(CL.T_Named "uint32_t", "_nstable") :: members
	(* add world method decls *)
	  fun memberFun (ty, name, params) = CL.D_Proto([], ty, name, params)
	  val members =
		memberFun (CL.voidTy, "swap_state", []) ::
		memberFun (CL.uint32, "run", [CL.PARAM([], CL.uint32, "max_nsteps")]) ::
		memberFun (CL.boolTy, "initially", []) ::
		memberFun (CL.boolTy, "alloc", [
		    CL.PARAM([], CL.T_Array(CL.int32, SOME nAxes), "base"),
		    CL.PARAM([], CL.T_Array(CL.uint32, SOME nAxes), "size")
		  ]) ::
		memberFun (CL.boolTy, "init", []) ::
		CL.D_Destr([], NONE, "world", NONE) ::
		CL.D_Constr([], NONE, "world", [], [], NONE) ::
		members
	  in
	    CL.D_ClassDef{
		name = "world",
		from = SOME "public diderot::world_base",
		public = List.rev members,
		protected = [],
		private = []
	      }
	  end

    fun genInitiallyFun (env : CodeGenEnv.t, strandName, create) = let
	  val strandName = Atom.toString strandName
	  val env = Env.insert(env, PseudoVars.world, "this")
	  val thisV = CL.mkVar "this"
	  val spec = Env.target env
	  val {dim, locals, prefix, loops, body} = Util.decomposeCreate create
	(* for each loop in the nest, we return the tuple
	 *	(stms, loExp, hiExp, szExp, mkLoop)
	 * where `stms` are the statements needed to define any new variables,
	 * `loExp` and `hiExp` are CLang expressions for the low and high loop
	 * bounds, `szExp` is the number of loop iterations, and mkLoop is a
	 * function for buildåing the CLang representation of the loop.
	 *)
	  fun doLoop env (Util.ForLoop(i, lo, hi)) = let
		  val (loV, loStms) = ToCxx.trExpToVar (env, CL.intTy, "lo", lo)
		  val (hiV, hiStms) = ToCxx.trExpToVar (env, CL.intTy, "hi", hi)
		  val szE = CL.mkBinOp(CL.mkBinOp(hiV, CL.#-, loV), CL.#+, CL.mkInt 1)
		  val stms = loStms @ hiStms
		  fun mkLoop (env, mkBody) = let
			val iV = TreeVar.name i
			in
			  CL.mkFor(
			    [(CL.intTy, iV, loV)],
			    CL.mkBinOp(CL.mkVar iV, CL.#<=, hiV),
			    [CL.mkPostOp(CL.mkVar iV, CL.^++)],
			    mkBody (Env.insert (env, i, iV)))
			end
		  in
		    (stms, loV, hiV, szE, mkLoop)
		  end
	    | doLoop env (Util.ForeachLoop(i, seq)) = let
		  val seqTy = ToCxx.trType (env, TreeTypes.SeqTy(TreeVar.ty i, NONE))
		  val (seqV, stms) = ToCxx.trExpToVar (env, seqTy, "seq", seq)
		  val szE = CL.mkDispatch(seqV, "length", [])
		  fun mkLoop (env, mkBody) = raise Fail "FIXME"
		  in
		    (stms, CL.mkInt 0, szE, szE, mkLoop)
		  end
	  fun tr env = let
		val (env, prefixCode) = TreeToCxx.trStms (env, prefix)
		val loopInfo = List.map (doLoop env) loops
	      (* collect the statements that define the loop bounds *)
		val bndsStms = List.foldr
		      (fn ((stms, _, _, _, _), stms') => stms @ stms')
			[] loopInfo
		val allocStm =
                      CL.mkIfThen(CL.mkIndirectDispatch(thisV, "alloc", [
                          CL.mkVar "base",
                          CL.mkVar "size"
                        ]),
                      (* then *)
                        CL.mkBlock [
                            CL.mkReturn(SOME(CL.mkVar "true"))
                          ])
                      (* endif *)
		fun mkArrDcl (ty, name, dim, init) = CL.mkDecl(
		      CL.T_Array(ty, SOME dim), name,
		      SOME(CL.I_Exps(List.map CL.I_Exp init)))
	      (* code to allocate strands *)
		val allocCode = (case dim
		       of NONE => let (* collection of strands *)
			    val (sz1::szs) = List.map #3 loopInfo
			    val sizeExp = List.foldl
				  (fn (sz, lhs) => CL.mkBinOp(lhs, CL.#+, sz))
				    sz1 szs
			    in [
			      mkArrDcl(CL.int32, "base", 1, [CL.mkInt 0]),
			      mkArrDcl(CL.uint32, "size", 1, [sizeExp]),
			      allocStm
			    ] end
			| SOME d => []
		      (* end case *))
		val loopCode = let
		      fun statePtr inout =
			    CL.mkAddrOf(CL.mkSubscript(CL.mkIndirect(thisV, inout), CL.mkVar "ix"))
		      fun mkNest [] env = ToCxx.trWithLocals (env, #locals body,
			    fn env => let
				val (env, stms') = ToCxx.trStms (env, #stms body)
				val (_, args) = #newStm body
				val args' = List.map (fn e => ToCxx.trExp(env, e)) args
				val args' = let
				      val state = if TargetSpec.dualState spec
					    then "_inState"
					    else "_state"
				      in
					statePtr state :: args'
				      end
				val args' = if #hasGlobals spec
				      then CL.mkIndirect(thisV, "_globals") :: args'
				      else args'
				val newStm = CL.mkCall(strandName ^ "_init", args')
				val newStms = if TargetSpec.dualState spec
				      then [
					  newStm,
					  CL.mkCall("memcpy", [
					      statePtr "_outState", statePtr "_inState",
					      CL.mkSizeof(CL.T_Named(strandName ^ "_strand"))
					    ])
					]
				      else [newStm]
				in
				  stms' @ newStms
				end)
			| mkNest ((_, _, _, _, mkLoop)::r) env = mkLoop (env, mkNest r)
		      in 
			mkNest loopInfo env
		      end
		val stms = prefixCode @ bndsStms @ allocCode @ [
			CL.mkDecl(CL.uint32, "ix", SOME(CL.I_Exp(CL.E_Int(0, CL.uint32)))),
			loopCode,
                        CL.mkAssign(
			  CL.mkIndirect(thisV, "_stage"),
			  CL.mkVar "diderot::POST_INITIALLY"),
                        CL.mkReturn(SOME(CL.mkVar "false"))
                      ]
		val stms = if #hasGlobals spec
		      then CL.mkIfThen (CL.mkApply ("init_globals", [thisV]),
			  CL.mkReturn(SOME(CL.mkVar "true"))
			) ::
			CL.mkDeclInit (
			  RN.globalPtrTy, RN.globalsVar, CL.mkIndirect(thisV, "_globals")) ::
			stms
		      else stms
		in
		  stms
		end (* tr *)
	  val body = TreeToCxx.trWithLocals (env, locals, tr)
	  in
            CL.D_Func([], CL.boolTy, "world::initially", [], body)
	  end

  end

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