[Swift-commit] r8098 - SwiftTutorials/ATPESC_2014-08-14/swift-t/examples/03-blas

[wozniak at ci.uchicago.edu]

Author: wozniak
Date: 2014-08-12 11:13:03 -0500 (Tue, 12 Aug 2014)
New Revision: 8098

Added:
   SwiftTutorials/ATPESC_2014-08-14/swift-t/examples/03-blas/blas_wrap.c
Log:
Adding blas_wrap.c

Added: SwiftTutorials/ATPESC_2014-08-14/swift-t/examples/03-blas/blas_wrap.c
===================================================================
--- SwiftTutorials/ATPESC_2014-08-14/swift-t/examples/03-blas/blas_wrap.c	                        (rev 0)
+++ SwiftTutorials/ATPESC_2014-08-14/swift-t/examples/03-blas/blas_wrap.c	2014-08-12 16:13:03 UTC (rev 8098)
@@ -0,0 +1,83 @@
+
+#include <assert.h>
+
+#include <tcl.h>
+
+#include "cblas.h"
+
+/**
+   Set leaf package name here:
+*/
+#define LEAF_PKG_NAME blas
+
+/**
+   Set leaf package version here:
+*/
+#define LEAF_PKG_VERSION 0.0.1
+
+/**
+   Shorten command creation lines.
+   The namespace is prepended
+ */
+#define COMMAND(tcl_function, pkg, c_function)
+
+/**
+   usage: blas::ddot [ N blob_X blob_Y ] => double_result
+   Z = dot product X*Y
+ */
+static int
+BLAS_ddot_Cmd(ClientData cdata, Tcl_Interp *interp,
+              int objc, Tcl_Obj *const objv[])
+{
+  assert(objc == 4);
+  int N;
+  double* X;
+  double* Y;
+  int rc;
+
+  // Unpack Tcl inputs
+  rc = Tcl_GetIntFromObj(interp, objv[1], &N);
+  assert(rc == TCL_OK);
+  long pointer;
+  rc = Tcl_GetLongFromObj(interp, objv[2], &pointer);
+  assert(rc == TCL_OK);
+  X = (double*) pointer;
+  rc = Tcl_GetLongFromObj(interp, objv[3], &pointer);
+  assert(rc == TCL_OK);
+  Y = (double*) pointer;
+
+  /* printf("N: %i\n", N); */
+  /* for (int i = 0; i < N; i++) */
+  /* { */
+  /*   printf("X[%i]=%f\n", i, X[i]); */
+  /*   printf("Y[%i]=%f\n", i, Y[i]); */
+  /* } */
+
+  // Call BLAS
+  double Z = cblas_ddot(N, X, 1, Y, 1);
+
+  // Pack Tcl outputs
+  Tcl_Obj* result = Tcl_NewDoubleObj(Z);
+  Tcl_SetObjResult(interp, result);
+  return TCL_OK;
+}
+
+int DLLEXPORT
+Tclblas_Init(Tcl_Interp *interp)
+{
+  if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
+    return TCL_ERROR;
+
+  if (Tcl_PkgProvide(interp, "blas", "0.0.1") == TCL_ERROR)
+    return TCL_ERROR;
+
+  Tcl_CreateObjCommand(interp,
+                       "blas::c::ddot", BLAS_ddot_Cmd,
+                       NULL, NULL);
+
+  Tcl_Namespace* ns =
+    Tcl_FindNamespace(interp, "blas", NULL, 0);
+
+  Tcl_Export(interp, ns, "*", 0);
+  return TCL_OK;
+}