void EchoIt(MLINK stdlink,MLINK ml,bool b) { bool inCompound = false; int i; double d; char * s = 0; char * t = 0; long m,n; switch(MLGetType(stdlink)) { case MLTKINT; MLGetInteger(stdlink,&i); MLPutInteger(ml,i); break; case MLTKSYMB; MLGetSymbol(stdlink,&s); t = new char[strlen(s)+4]; strcpy(t,s); strcat(t,"MXS"); MLPutSymbol(ml,t); delete [] t; MLDisownSymbol(stdlink,s); break; case MLTKSTR; MLGetString(stdlink,&s); MLPutString(ml,s); MLDisownString(stdlink,s); break; case MLTKINT; MLGetInteger(stdlink,&i); MLPutInteger(ml,i); break; case MLTKFUNC; MLGetFunction(stdlink,&s,m); strcpy(t,s); strcat(t,"MXS"); if(strcmp(s,"CompoundExpression")==0 && b) { inCompound = true; MLPutFunction(ml,t,2*m); } else { MLPutFunction(ml,t,m); }; delete [] t; for(long n=1;n<=m;++n) { if(inCompound) { MLPutFunction(ml,"Print",4L); MLPutString(ml,"Function:"); MLPutString(ml,s); MLPutString(ml," "); MLPutInteger(ml,s_number); ++s_number; }; EchoIt(stdlink,ml,b); }; inCompound = false; break; default: DBG(); break; }; };
PetscErrorCode PetscViewerMathematicaPutCSRMatrix(PetscViewer viewer, int m, int n, int *i, int *j, PetscReal *a) { PetscViewer_Mathematica *vmath = (PetscViewer_Mathematica*) viewer->data; MLINK link = vmath->link; /* The link to Mathematica */ const char *symbol; char *name; PetscBool match; PetscErrorCode ierr; PetscFunctionBegin; /* Determine the object name */ if (!vmath->objName) name = "mat"; else name = (char*) vmath->objName; /* Make sure Mathematica recognizes sparse matrices */ MLPutFunction(link, "EvaluatePacket", 1); MLPutFunction(link, "Needs", 1); MLPutString(link, "LinearAlgebra`CSRMatrix`"); MLEndPacket(link); /* Skip packets until ReturnPacket */ ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT); CHKERRQ(ierr); /* Skip ReturnPacket */ MLNewPacket(link); /* Send the CSRMatrix object */ MLPutFunction(link, "EvaluatePacket", 1); MLPutFunction(link, "Set", 2); MLPutSymbol(link, name); MLPutFunction(link, "CSRMatrix", 5); MLPutInteger(link, m); MLPutInteger(link, n); MLPutFunction(link, "Plus", 2); MLPutIntegerList(link, i, m+1); MLPutInteger(link, 1); MLPutFunction(link, "Plus", 2); MLPutIntegerList(link, j, i[m]); MLPutInteger(link, 1); MLPutRealList(link, a, i[m]); MLEndPacket(link); /* Skip packets until ReturnPacket */ ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT); CHKERRQ(ierr); /* Skip ReturnPacket */ MLNewPacket(link); /* Check that matrix is valid */ MLPutFunction(link, "EvaluatePacket", 1); MLPutFunction(link, "ValidQ", 1); MLPutSymbol(link, name); MLEndPacket(link); ierr = PetscViewerMathematicaSkipPackets(viewer, RETURNPKT); CHKERRQ(ierr); MLGetSymbol(link, &symbol); ierr = PetscStrcmp("True", (char*) symbol, &match); CHKERRQ(ierr); if (!match) { MLDisownSymbol(link, symbol); SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Invalid CSR matrix in Mathematica"); } MLDisownSymbol(link, symbol); /* Skip ReturnPacket */ MLNewPacket(link); PetscFunctionReturn(0); }
static int processPacket(MLINK link, int indent) { static int isHead = 0; int tokenType = MLGetNext(link); int ierr; PetscFunctionBegin; ierr = printIndent(indent);CHKERRQ(ierr); switch (tokenType) { case MLTKFUNC: { long numArguments; int arg; printf("Function:\n"); MLGetArgCount(link, &numArguments); /* Process head */ printf(" Head:\n"); isHead = 1; ierr = processPacket(link, indent+4); if (ierr) PetscFunctionReturn(ierr); isHead = 0; /* Process arguments */ printf(" Arguments:\n"); for (arg = 0; arg < numArguments; arg++) { ierr = processPacket(link, indent+4);CHKERRQ(ierr); } } break; case MLTKSYM: { const char *symbol; MLGetSymbol(link, &symbol); printf("Symbol: %s\n", symbol); if (isHead && !strcmp(symbol, "Shutdown")) { MLDisownSymbol(link, symbol); PetscFunctionReturn(2); } MLDisownSymbol(link, symbol); } break; case MLTKINT: { int i; MLGetInteger(link, &i); printf("Integer: %d\n", i); } break; case MLTKREAL: { double r; MLGetReal(link, &r); printf("Real: %g\n", r); } break; case MLTKSTR: { const char *string; MLGetString(link, &string); printf("String: %s\n", string); MLDisownString(link, string); } break; default: printf("Unknown code %d\n", tokenType); MLClearError(link); fprintf(stderr, "ERROR: %s\n", (char*) MLErrorMessage(link)); PetscFunctionReturn(1); } PetscFunctionReturn(0); }