Actual source code: cstring.c


  2: #include <../src/vec/pf/pfimpl.h>

  4: /*
  5:         This PF generates a function on the fly and loads it into the running
  6:    program.
  7: */

  9: static PetscErrorCode PFView_String(void *value, PetscViewer viewer)
 10: {
 11:   PetscBool iascii;

 13:   PetscFunctionBegin;
 14:   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii));
 15:   if (iascii) PetscCall(PetscViewerASCIIPrintf(viewer, "String = %s\n", (char *)value));
 16:   PetscFunctionReturn(PETSC_SUCCESS);
 17: }

 19: static PetscErrorCode PFDestroy_String(void *value)
 20: {
 21:   PetscFunctionBegin;
 22:   PetscCall(PetscFree(value));
 23:   PetscFunctionReturn(PETSC_SUCCESS);
 24: }

 26: /*
 27:     PFStringCreateFunction - Creates a function from a string

 29:    Collective over PF

 31:   Input Parameters:
 32: +    pf - the function object
 33: -    string - the string that defines the function

 35:   Output Parameter:
 36: .    f - the function pointer.

 38: .seealso: `PFSetFromOptions()`

 40: */
 41: PetscErrorCode PFStringCreateFunction(PF pf, char *string, void **f)
 42: {
 43: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
 44:   char      task[1024], tmp[PETSC_MAX_PATH_LEN], lib[PETSC_MAX_PATH_LEN], username[64];
 45:   FILE     *fd;
 46:   PetscBool tmpshared, wdshared, keeptmpfiles = PETSC_FALSE;
 47:   MPI_Comm  comm;
 48: #endif

 50:   PetscFunctionBegin;
 51: #if defined(PETSC_HAVE_DYNAMIC_LIBRARIES)
 52:   PetscCall(PetscFree(pf->data));
 53:   PetscCall(PetscStrallocpy(string, (char **)&pf->data));

 55:   /* create the new C function and compile it */
 56:   PetscCall(PetscSharedTmp(PetscObjectComm((PetscObject)pf), &tmpshared));
 57:   PetscCall(PetscSharedWorkingDirectory(PetscObjectComm((PetscObject)pf), &wdshared));
 58:   if (tmpshared) { /* do it in /tmp since everyone has one */
 59:     PetscCall(PetscGetTmp(PetscObjectComm((PetscObject)pf), tmp, PETSC_STATIC_ARRAY_LENGTH(tmp)));
 60:     PetscCall(PetscObjectGetComm((PetscObject)pf, &comm));
 61:   } else if (!wdshared) { /* each one does in private /tmp */
 62:     PetscCall(PetscGetTmp(PetscObjectComm((PetscObject)pf), tmp, PETSC_STATIC_ARRAY_LENGTH(tmp)));
 63:     comm = PETSC_COMM_SELF;
 64:   } else { /* do it in current directory */
 65:     PetscCall(PetscStrcpy(tmp, "."));
 66:     PetscCall(PetscObjectGetComm((PetscObject)pf, &comm));
 67:   }
 68:   PetscCall(PetscOptionsGetBool(((PetscObject)pf)->options, ((PetscObject)pf)->prefix, "-pf_string_keep_files", &keeptmpfiles, NULL));
 69:   PetscCall(PetscSNPrintf(task, PETSC_STATIC_ARRAY_LENGTH(task), "cd %s ; mkdir ${USERNAME} ; cd ${USERNAME} ; \\cp -f ${PETSC_DIR}/src/pf/impls/string/makefile ./makefile ; make  MIN=%" PetscInt_FMT " NOUT=%" PetscInt_FMT " -f makefile petscdlib STRINGFUNCTION=\"%s\" ; %s ;  sync\n", tmp, pf->dimin, pf->dimout, string, keeptmpfiles ? "\\rm -f makefile petscdlib.c libpetscdlib.a" : ""));

 71:   #if defined(PETSC_HAVE_POPEN)
 72:   PetscCall(PetscPOpen(comm, NULL, task, "r", &fd));
 73:   PetscCall(PetscPClose(comm, fd));
 74:   #else
 75:   SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "Cannot run external programs on this machine");
 76:   #endif

 78:   PetscCallMPI(MPI_Barrier(comm));

 80:   /* load the apply function from the dynamic library */
 81:   PetscCall(PetscGetUserName(username, PETSC_STATIC_ARRAY_LENGTH(username)));
 82:   PetscCall(PetscSNPrintf(lib, PETSC_STATIC_ARRAY_LENGTH(lib), "%s/%s/libpetscdlib", tmp, username));
 83:   PetscCall(PetscDLLibrarySym(comm, NULL, lib, "PFApply_String", f));
 84:   PetscCheck(f, PetscObjectComm((PetscObject)pf), PETSC_ERR_ARG_WRONGSTATE, "Cannot find function %s", lib);
 85: #endif
 86:   PetscFunctionReturn(PETSC_SUCCESS);
 87: }

 89: static PetscErrorCode PFSetFromOptions_String(PF pf, PetscOptionItems *PetscOptionsObject)
 90: {
 91:   PetscBool flag;
 92:   char      value[PETSC_MAX_PATH_LEN];
 93:   PetscErrorCode (*f)(void *, PetscInt, const PetscScalar *, PetscScalar *) = NULL;

 95:   PetscFunctionBegin;
 96:   PetscOptionsHeadBegin(PetscOptionsObject, "String function options");
 97:   PetscCall(PetscOptionsString("-pf_string", "Enter the function", "PFStringCreateFunction", "", value, sizeof(value), &flag));
 98:   if (flag) {
 99:     PetscCall(PFStringCreateFunction(pf, value, (void **)&f));
100:     pf->ops->apply = f;
101:   }
102:   PetscOptionsHeadEnd();
103:   PetscFunctionReturn(PETSC_SUCCESS);
104: }

106: typedef PetscErrorCode (*FCN)(void *, PetscInt, const PetscScalar *, PetscScalar *); /* force argument to next function to not be extern C*/

108: PETSC_EXTERN PetscErrorCode PFCreate_String(PF pf, void *value)
109: {
110:   FCN f = NULL;

112:   PetscFunctionBegin;
113:   if (value) PetscCall(PFStringCreateFunction(pf, (char *)value, (void **)&f));
114:   PetscCall(PFSet(pf, f, NULL, PFView_String, PFDestroy_String, NULL));
115:   pf->ops->setfromoptions = PFSetFromOptions_String;
116:   PetscFunctionReturn(PETSC_SUCCESS);
117: }