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; }; };
int _EchoConvert(MLINK mlp) { long errno = 0L; MLINK ml = MLLoopbackOpen(stdenv,&errno); int n; MLGetInteger(stdlink,n); bool b = n!=0; EchoIt(stdlink,ml,b); return 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); }