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

SCM Repository

[diderot] View of /branches/vis12-cl/src/compiler/c-util/output-util.sml
ViewVC logotype

View of /branches/vis12-cl/src/compiler/c-util/output-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2712 - (download) (annotate)
Sun Sep 21 14:14:40 2014 UTC (4 years, 10 months ago) by jhr
File size: 6043 byte(s)
  Working on OpenCL support
(* output-util.sml
 *
 * COPYRIGHT (c) 2014 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Common code for output.
 *)

structure OutputUtil : sig

  (* return information about the output type.  This is a tuple
   *
   *    (c-type, nrrd-type, nrrd-axis-kind, # elements)
   *)
    val infoOf : Properties.props * TreeIL.Ty.ty -> (CLang.ty * NrrdEnums.ty * NrrdEnums.axis_kind * int)

  (* code fragment to allocate nrrd data and check for errors
	if (nrrdMaybeAlloc_nva(<nrrdVar>, <nrrdType>, <nDims>, sizes) != 0) {
	    char *msg = biffGetDone(NRRD);
	    biffMsgAdd (wrld->errors, msg);
	    FREE (msg);
	    return true;
	}
   *)
    val maybeAlloc : CLang.exp * CLang.var * int -> CLang.stm

    val genOutput : Properties.props * (TreeIL.Ty.ty * string) list -> CLang.decl list

  end = struct

    structure Ty = TreeIL.Ty
    structure CL = CLang
    structure N = CNames
    structure Nrrd = NrrdEnums

    val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
    val filePtrTy = CL.T_Ptr(CL.T_Named "FILE")

  (* variables in the generated code *)
    val wrldV = CL.mkVar "wrld"
    val sizesV = CL.mkVar "sizes"
    val nDataV = CL.mkVar "nData"
    val nLengthsV = CL.mkVar "nLengths"
    val NRRD = CL.mkVar "NRRD"
    val msgV = CL.mkVar "msg"

    fun wrldPtr tgt = CL.T_Ptr(CL.T_Named(N.worldTy tgt))

    fun infoOf (tgt : Properties.props, ty) = (case ty
           of Ty.IntTy => if #longint tgt
		then (CL.int64, Nrrd.TypeLLong, Nrrd.KindScalar, 1)
		else (CL.int32, Nrrd.TypeInt, Nrrd.KindScalar, 1)
            | Ty.TensorTy [] => if #double tgt
		then (CL.double, Nrrd.TypeDouble, Nrrd.KindScalar, 1)
		else (CL.float, Nrrd.TypeFloat, Nrrd.KindScalar, 1)
            | Ty.TensorTy dims => let
                val (axisKind, nElems) = (case dims
                       of [2] => (Nrrd.Kind2Vector, 2)
                        | [3] => (Nrrd.Kind3Vector, 3)
                        | [4] => (Nrrd.Kind4Vector, 4)
                        | [2,2] => (Nrrd.Kind2DMatrix, 4)
                        | [3,3] => (Nrrd.Kind3DMatrix, 9)
                        | _ => (Nrrd.KindList, List.foldl Int.* 1 dims)
                      (* end case *))
                in
                  if #double tgt
                    then (CL.double, Nrrd.TypeDouble, axisKind, nElems)
                    else (CL.float, Nrrd.TypeFloat, axisKind, nElems)
                end
            | Ty.SeqTy(ty, n) => raise Fail "FIXME" (*let
		val (elemTy, nrrdTy, dims) = infoOf (tgt, ty)
		in
		  (elemTy, nrrdTy, n::dims)
		end*)
            | _ => raise Fail(concat["GetOutput.infoOf(", Ty.toString ty, ")"])
	  (* end case *))

  (* code fragment to allocate nrrd data and check for errors
	if (nrrdMaybeAlloc_nva(<nrrdVar>, <nrrdType>, <nDims>, sizes) != 0) {
	    char *msg = biffGetDone(NRRD);
	    biffMsgAdd (wrld->errors, msg);
	    FREE (msg);
	    return true;
	}
   *)
    fun maybeAlloc (nrrdVar, nrrdType, nDims) = 
	  CL.mkIfThen(
	    CL.mkBinOp(
	      CL.mkApply("nrrdMaybeAlloc_nva", [
		  nrrdVar, CL.mkVar nrrdType, CL.mkInt(IntInf.fromInt nDims), sizesV
		]),
	      CL.#!=,
	      CL.mkInt 0),
	  (* then *)
	    CL.mkBlock[
		CL.mkDeclInit(CL.charPtr, "msg", CL.mkApply("biffGetDone", [NRRD])),
		World.errorMsgAdd msgV,
		CL.mkCall("FREE", [msgV]),
		CL.mkReturn(SOME(CL.mkVar "true"))
	      ]
	  (* endif*))

  (* generate the nrrd-file output and print functions used by standalone executables *)
    fun genOutput (tgt : Properties.props, outputs) = let
	  fun isDyn ty = (case ty of Ty.DynSeqTy _ => true | _ => false)
(* FIXME: use biffMsgAddF and return error status *)
	  fun error (fmt, msg) = CL.mkBlock[
		  CL.mkCall("fprintf", [CL.mkVar "stderr", CL.mkStr fmt, msg]),
		  CL.mkCall("exit", [CL.mkInt 1])
		]
	  val outDecls = if List.exists (isDyn o #1) outputs
		then [CL.mkDecl(nrrdPtrTy, "nLengths", NONE), CL.mkDecl(nrrdPtrTy, "nData", NONE)]
		else [CL.mkDecl(nrrdPtrTy, "nData", NONE)]
	  val prDecls = outDecls @ [CL.mkDecl(filePtrTy, "outS", NONE)]
	  fun nrrdNew v = CL.mkAssign(v, CL.mkApply("nrrdNew", []))
	  fun nrrdNuke v = CL.mkCall("nrrdNuke", [v])
	  fun writeNrrd (ty, name) =
		if isDyn ty
		  then [
		      nrrdNew (nLengthsV),
		      nrrdNew (nDataV),
		      CL.mkIfThenElse(
			CL.mkApply(N.outputGet(tgt, name), [wrldV, nLengthsV, nDataV]),
		      (* then *)
			  error ("Error getting nrrd data:\n%s\n",
			    CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "errors")])),
		      (* else *)
			CL.mkIfThen(
			  CL.mkBinOp(
			    CL.mkApply("nrrdSave", [
				CL.mkStr(OS.Path.joinBaseExt{base=name^"-len", ext=SOME "nrrd"}),
				nLengthsV, CL.mkVar "NULL"
			      ]),
			    CL.#||,
			    CL.mkApply("nrrdSave", [
				CL.mkStr(OS.Path.joinBaseExt{base=name^"-data", ext=SOME "nrrd"}),
				nDataV, CL.mkVar "NULL"
			      ])),
			(* then *)
			  error ("Error saving nrrd:\n%s\n", CL.mkApply("biffGetDone", [NRRD]))
			(* endif *))
		      (* endif *)),
		      nrrdNuke nLengthsV,
		      nrrdNuke nDataV
		    ]
		  else [
		      nrrdNew (nDataV),
		      CL.mkIfThenElse(
			CL.mkApply(N.outputGet(tgt, name), [wrldV, nDataV]),
		      (* then *)
			  error ("Error getting nrrd data:\n%s\n",
			    CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "errors")])),
		      (* else *)
			CL.mkIfThen(
			  CL.mkApply("nrrdSave", [
			      CL.mkStr(OS.Path.joinBaseExt{base=name, ext=SOME "nrrd"}),
			      nDataV, CL.mkVar "NULL"
			    ]),
			(* then *)
			  error ("Error saving nrrd:\n%s\n", CL.mkApply("biffGetDone", [NRRD]))
			(* endif *))
		      (* endif *)),
		      nrrdNuke nDataV
		    ]
	  fun printNrrd (ty, name) = [] (* FIXME *)
	  in [
	    CL.D_Func(["static"], CL.voidTy, "WriteOutput", [CL.PARAM([], wrldPtr tgt, "wrld")],
	      CL.mkBlock(outDecls @ List.foldr (fn (output, l) => writeNrrd output @ l) [] outputs)),
	    CL.D_Func(["static"], CL.voidTy, "PrintOutput", [CL.PARAM([], wrldPtr tgt, "wrld")],
	      CL.mkBlock(prDecls @ List.foldr (fn (output, l) => printNrrd output @ l) [] outputs))
	  ] end

  end

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