Dynamic_link: add demos using stdlibs / intrinsics 57/19757/1
Clément DAVID [Mon, 12 Feb 2018 21:32:51 +0000 (22:32 +0100)]
These demos could be used as fast checks for basic linking with
standard libs (libc, libstdc++, libgfortran).

Change-Id: Id965e82954402feddac3c99b7020a27a84889a5d

scilab/modules/dynamic_link/demos/call_c_stdlib.sce [new file with mode: 0644]
scilab/modules/dynamic_link/demos/call_cxx.sce [new file with mode: 0644]
scilab/modules/dynamic_link/demos/call_cxx_stdlib.sce [new file with mode: 0644]
scilab/modules/dynamic_link/demos/call_fortran_stdlib.sce [new file with mode: 0644]
scilab/modules/dynamic_link/demos/dynamic_link.dem.gateway.sce

diff --git a/scilab/modules/dynamic_link/demos/call_c_stdlib.sce b/scilab/modules/dynamic_link/demos/call_c_stdlib.sce
new file mode 100644 (file)
index 0000000..20d7736
--- /dev/null
@@ -0,0 +1,123 @@
+//
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2009 - DIGITEO - Allan CORNET
+// Copyright (C) 2018 - ESI Group - Clement DAVID
+//
+// This file is distributed under the same license as the Scilab package.
+//
+
+//           CALLING EXTERNAL C FUNCTION
+
+if haveacompiler() then
+
+
+    // we use TMPDIR for compilation
+
+    f1=["#include <math.h>";
+    "void bar(double *a,double *b,double *c)";
+    "{ *c = expm1(*a * log1p(*b)); }"  ];
+
+    i=["#include <stdlib.h>"
+    "#include <api_scilab.h>"
+    "#include <Scierror.h>"
+    "#include <localization.h>"
+    ""
+    "extern int bar(double *x, double *y, double *z);"
+    ""
+    "int sci_bar(char *fname, void* pvApiCtx)"
+    "{"
+    "  SciErr sciErr;"
+    ""
+    "  int m1 = 0, n1 = 0;"
+    "  double *pdVarOne = NULL;"
+    "  int *piAddressVarOne = NULL;"
+    "  int m2 = 0, n2 = 0;"
+    "  double *pdVarTwo = NULL;"
+    "  int *piAddressVarTwo = NULL;"
+    "  double *pdblOut = NULL;"
+    ""
+    "  CheckInputArgument(pvApiCtx, 2, 2);"
+    "  CheckOutputArgument(pvApiCtx, 0, 1);"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pdVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 1, &pdblOut);"
+    "  if (sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  bar(pdVarOne, pdVarTwo, pdblOut);"
+    ""
+    "  AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;"
+    "  ReturnArguments(pvApiCtx);"
+    "  return 0;"
+    "}"]
+
+    mprintf("\n");
+    mprintf(gettext("Calling a C function from Scilab.\n"));
+
+    disp(f1);
+
+    if ~c_link("bar") then
+        cur_ilib_verbose = ilib_verbose();
+        ilib_verbose(1);
+        path = pwd();
+        chdir(TMPDIR);
+        mputl(f1,"bar.c");
+        mputl(i,"sci_bar.c");
+
+        mprintf("\n");
+        mprintf(gettext("Calling ilib_for_link to build C function.\n"));
+        lib_ = ilib_for_link(["bar"], "bar.c", [],"c");
+        link(lib_, "bar", "c");
+        ilib_build("gw_bar",["bar" "sci_bar"],"sci_bar.c",basename(lib_));
+        exec loader.sce ;
+        chdir(path);
+        ilib_verbose(cur_ilib_verbose);
+    end
+
+    //Z = X+Y by C function
+    X = 5;
+    Y = 7;
+    mprintf("\n");
+    mprintf(gettext("Calling C function. Z = (1+Y)**X - 1"));
+    mprintf("\n");
+    mprintf(gettext("with X = %d"), X);
+    mprintf("\n");
+    mprintf(gettext("with Y = %d"), Y);
+    mprintf("\n");
+    mprintf("Z = bar(X, Y);");
+    mprintf("\n");
+    Z = bar(X, Y);
+    mprintf(gettext("Result Z = %d"), Z);
+    mprintf("\n");
+
+end
diff --git a/scilab/modules/dynamic_link/demos/call_cxx.sce b/scilab/modules/dynamic_link/demos/call_cxx.sce
new file mode 100644 (file)
index 0000000..643ebfb
--- /dev/null
@@ -0,0 +1,122 @@
+//
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2018 - ESI Group - Clement DAVID
+//
+// This file is distributed under the same license as the Scilab package.
+//
+
+//           CALLING EXTERNAL C FUNCTION
+
+if haveacompiler() then
+
+
+    // we use TMPDIR for compilation
+
+    f1=["extern ""C"""
+    "void fooxx(double *a,double *b,double *c)";
+    "{ *c = *a + *b; }"  ];
+
+    i=["#include <stdlib.h>"
+    "#include <api_scilab.h>"
+    "#include <Scierror.h>"
+    "#include <localization.h>"
+    ""
+    "extern int fooxx(double *x, double *y, double *z);"
+    ""
+    "int sci_fooxx(char *fname, void* pvApiCtx)"
+    "{"
+    "  SciErr sciErr;"
+    ""
+    "  int m1 = 0, n1 = 0;"
+    "  double *pdVarOne = NULL;"
+    "  int *piAddressVarOne = NULL;"
+    "  int m2 = 0, n2 = 0;"
+    "  double *pdVarTwo = NULL;"
+    "  int *piAddressVarTwo = NULL;"
+    "  double *pdblOut = NULL;"
+    ""
+    "  CheckInputArgument(pvApiCtx, 2, 2);"
+    "  CheckOutputArgument(pvApiCtx, 0, 1);"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pdVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 1, &pdblOut);"
+    "  if (sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  fooxx(pdVarOne, pdVarTwo, pdblOut);"
+    ""
+    "  AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;"
+    "  ReturnArguments(pvApiCtx);"
+    "  return 0;"
+    "}"]
+
+    mprintf("\n");
+    mprintf(gettext("Calling a C++ function from Scilab.\n"));
+
+    disp(f1);
+
+    if ~c_link("fooxx") then
+        cur_ilib_verbose = ilib_verbose();
+        ilib_verbose(1);
+        path = pwd();
+        chdir(TMPDIR);
+        mputl(f1,"fooxx.cxx");
+        mputl(i,"sci_fooxx.c");
+
+        mprintf("\n");
+        mprintf(gettext("Calling ilib_for_link to build C++ function.\n"));
+        lib_ = ilib_for_link(["fooxx"], "fooxx.cxx", [],"c");
+        link(lib_, "fooxx", "c");
+        ilib_build("gw_fooxx",["fooxx" "sci_fooxx"],"sci_fooxx.c",basename(lib_));
+        exec loader.sce ;
+        chdir(path);
+        ilib_verbose(cur_ilib_verbose);
+    end
+
+    //Z = X+Y by C function
+    X = 5;
+    Y = 7;
+    mprintf("\n");
+    mprintf(gettext("Calling C++ function. Z = X+Y"));
+    mprintf("\n");
+    mprintf(gettext("with X = %d"), X);
+    mprintf("\n");
+    mprintf(gettext("with Y = %d"), Y);
+    mprintf("\n");
+    mprintf("Z = fooxx(X, Y);");
+    mprintf("\n");
+    Z = fooxx(X, Y);
+    mprintf(gettext("Result Z = %d"), Z);
+    mprintf("\n");
+
+end
diff --git a/scilab/modules/dynamic_link/demos/call_cxx_stdlib.sce b/scilab/modules/dynamic_link/demos/call_cxx_stdlib.sce
new file mode 100644 (file)
index 0000000..ab905a5
--- /dev/null
@@ -0,0 +1,124 @@
+//
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2009 - DIGITEO - Allan CORNET
+// Copyright (C) 2018 - ESI Group - Clement DAVID
+//
+// This file is distributed under the same license as the Scilab package.
+//
+
+//           CALLING EXTERNAL C FUNCTION
+
+if haveacompiler() then
+
+
+    // we use TMPDIR for compilation
+
+    f1=["#include <cmath>";
+    "extern ""C""";
+    "void barxx(double *a,double *b,double *c)";
+    "{ *c = std::expm1(*a * std::log1p(*b)); }"  ];
+
+    i=["#include <stdlib.h>"
+    "#include <api_scilab.h>"
+    "#include <Scierror.h>"
+    "#include <localization.h>"
+    ""
+    "extern int barxx(double *x, double *y, double *z);"
+    ""
+    "int sci_barxx(char *fname, void* pvApiCtx)"
+    "{"
+    "  SciErr sciErr;"
+    ""
+    "  int m1 = 0, n1 = 0;"
+    "  double *pdVarOne = NULL;"
+    "  int *piAddressVarOne = NULL;"
+    "  int m2 = 0, n2 = 0;"
+    "  double *pdVarTwo = NULL;"
+    "  int *piAddressVarTwo = NULL;"
+    "  double *pdblOut = NULL;"
+    ""
+    "  CheckInputArgument(pvApiCtx, 2, 2);"
+    "  CheckOutputArgument(pvApiCtx, 0, 1);"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pdVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 1, &pdblOut);"
+    "  if (sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  barxx(pdVarOne, pdVarTwo, pdblOut);"
+    ""
+    "  AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;"
+    "  ReturnArguments(pvApiCtx);"
+    "  return 0;"
+    "}"]
+
+    mprintf("\n");
+    mprintf(gettext("Calling a C++ function from Scilab.\n"));
+
+    disp(f1);
+
+    if ~c_link("barxx") then
+        cur_ilib_verbose = ilib_verbose();
+        ilib_verbose(1);
+        path = pwd();
+        chdir(TMPDIR);
+        mputl(f1,"barxx.cxx");
+        mputl(i,"sci_barxx.c");
+
+        mprintf("\n");
+        mprintf(gettext("Calling ilib_for_link to build C++ function.\n"));
+        lib_ = ilib_for_link(["barxx"], "barxx.cxx", [],"c");
+        link(lib_, "barxx", "c");
+        ilib_build("gw_barxx",["barxx" "sci_barxx"],"sci_barxx.c",basename(lib_));
+        exec loader.sce ;
+        chdir(path);
+        ilib_verbose(cur_ilib_verbose);
+    end
+
+    //Z = X+Y by C function
+    X = 5;
+    Y = 7;
+    mprintf("\n");
+    mprintf(gettext("Calling C function. Z = (1+Y)**X - 1"));
+    mprintf("\n");
+    mprintf(gettext("with X = %d"), X);
+    mprintf("\n");
+    mprintf(gettext("with Y = %d"), Y);
+    mprintf("\n");
+    mprintf("Z = barxx(X, Y);");
+    mprintf("\n");
+    Z = barxx(X, Y);
+    mprintf(gettext("Result Z = %d"), Z);
+    mprintf("\n");
+
+end
diff --git a/scilab/modules/dynamic_link/demos/call_fortran_stdlib.sce b/scilab/modules/dynamic_link/demos/call_fortran_stdlib.sce
new file mode 100644 (file)
index 0000000..055704b
--- /dev/null
@@ -0,0 +1,123 @@
+//
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2009 - DIGITEO - Allan CORNET
+// Copyright (C) 2018 - ESI Group - Clement DAVID
+//
+// This file is distributed under the same license as the Scilab package.
+//
+
+if haveacompiler() then
+
+    //           CALLING EXTERNAL FORTRAN SUBROUTINE
+
+    f1f = ["      subroutine barf(a,b,c)";
+    "      double precision  a,b,c";
+    "      c=exp(a*log(1+b))-1 ";
+    "      return";
+    "      end"];
+
+    i=["#include <stdlib.h>"
+    "#include <api_scilab.h>"
+    "#include <Scierror.h>"
+    "#include <localization.h>"
+    ""
+    "extern int C2F(barf)(double *x, double *y, double *z);"
+    ""
+    "int sci_barf(char *fname, void* pvApiCtx)"
+    "{"
+    "  SciErr sciErr;"
+    ""
+    "  int m1 = 0, n1 = 0;"
+    "  double *pdVarOne = NULL;"
+    "  int *piAddressVarOne = NULL;"
+    "  int m2 = 0, n2 = 0;"
+    "  double *pdVarTwo = NULL;"
+    "  int *piAddressVarTwo = NULL;"
+    "  double *pdblOut = NULL;"
+    ""
+    "  CheckInputArgument(pvApiCtx, 2, 2);"
+    "  CheckOutputArgument(pvApiCtx, 0, 1);"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pdVarOne);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdVarTwo);"
+    "  if(sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 1, &pdblOut);"
+    "  if (sciErr.iErr)"
+    "  {"
+    "    printError(&sciErr, 0);"
+    "    return 0;"
+    "  }"
+    ""
+    "  C2F(barf)(pdVarOne, pdVarTwo, pdblOut);"
+    ""
+    "  AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;"
+    "  ReturnArguments(pvApiCtx);"
+    "  return 0;"
+    "}"]
+
+    mprintf("\n");
+    mprintf(gettext("Calling a Fortran subroutine from Scilab.\n"));
+
+    disp(f1f);
+
+    // we use TMPDIR for compilation
+
+    if ~c_link("barf") then
+        path = pwd();
+        chdir(TMPDIR);
+        mputl(f1f,"barf.f");
+        mputl(i,"sci_barf.c");
+
+        mprintf("\n");
+        mprintf(gettext("Calling ilib_for_link to build a Fortran subroutine.\n"));
+
+        lib_ = ilib_for_link(["barf"], "barf.f", [],"f");
+        link(lib_, "barf", "f");
+        ilib_build("gw_barf",["barf" "sci_barf"],"sci_barf.c",basename(lib_));
+        exec loader.sce ;
+        chdir(path)
+    end
+
+    //Z = X+Y by fortran subroutine
+    X = 5;
+    Y = 7;
+
+    mprintf("\n");
+    mprintf(gettext("Calling Fortran subroutine. Z = (1+Y)**X - 1"));
+    mprintf("\n");
+    mprintf(gettext("with X = %d"), X);
+    mprintf("\n");
+    mprintf(gettext("with Y = %d"), Y);
+    mprintf("\n");
+    mprintf("Z = barf(X, Y);");
+    mprintf("\n");
+    Z = barf(X, Y);
+    mprintf(gettext("Result Z = %d"), Z);
+    mprintf("\n");
+
+end
index d1d83bb..edd17c1 100644 (file)
@@ -1,5 +1,6 @@
 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
 // Copyright (C) 2009-2011 - DIGITEO - Allan CORNET
+// Copyright (C) 2018 - ESI Group - Clement DAVID
 //
 // This file is released under the 3-clause BSD license. See COPYING-BSD.
 
@@ -8,8 +9,12 @@ function subdemolist = demo_gateway()
     demopath = get_absolute_file_path("dynamic_link.dem.gateway.sce");
     add_demo(_("Dynamic link"), demopath+"dynamic_link.dem.gateway.sce");
 
-    subdemolist = [_("Call a C function")       , "call_c.sce" ;
-    _("Call a Fortran subroutine")      , "call_fortran.sce" ;];
+    subdemolist = [_("Call a C function")                   , "call_c.sce" ;
+    _("Call a C function (using C standard library)")       , "call_c_stdlib.sce" ;
+    _("Call a Fortran subroutine")                          , "call_fortran.sce" ;
+    _("Call a Fortran subroutine (with Fortran intrinsics)"), "call_fortran_stdlib.sce" ;
+    _("Call a C++ function")                                , "call_cxx.sce" ;
+    _("Call a C++ function (using C++ Standard Library)")   , "call_cxx_stdlib.sce" ;];
 
     subdemolist(:,2) = demopath + subdemolist(:,2)
 endfunction