1 static const char help[] = "Tests PETSc -- Mathematica connection\n"; 2 #include <petscksp.h> 3 #include <mathlink.h> 4 5 typedef enum { 6 MATHEMATICA_LINK_CREATE, 7 MATHEMATICA_LINK_CONNECT, 8 MATHEMATICA_LINK_LAUNCH 9 } LinkMode; 10 11 static int setupConnection(MLENV *env, MLINK *link, const char *linkhost, LinkMode linkmode) { 12 int argc = 5; 13 char *argv[5]; 14 char hostname[256]; 15 long lerr; 16 int ierr; 17 18 PetscFunctionBegin; 19 /* Link name */ 20 argv[0] = "-linkname"; 21 argv[1] = "8001"; 22 23 /* Link host */ 24 argv[2] = "-linkhost"; 25 if (!linkhost) { 26 PetscCall(PetscGetHostName(hostname, sizeof(hostname))); 27 argv[3] = hostname; 28 } else argv[3] = (char *)linkhost; 29 30 /* Link mode */ 31 switch (linkmode) { 32 case MATHEMATICA_LINK_CREATE: argv[4] = "-linkcreate"; break; 33 case MATHEMATICA_LINK_CONNECT: argv[4] = "-linkconnect"; break; 34 case MATHEMATICA_LINK_LAUNCH: argv[4] = "-linklaunch"; break; 35 } 36 37 *env = MLInitialize(0); 38 for (lerr = 0; lerr < argc; lerr++) printf("argv[%ld] = %s\n", lerr, argv[lerr]); 39 *link = MLOpenInEnv(*env, argc, argv, &lerr); 40 printf("lerr = %ld\n", lerr); 41 PetscFunctionReturn(0); 42 } 43 44 static int printIndent(int indent) { 45 int i; 46 47 PetscFunctionBegin; 48 for (i = 0; i < indent; i++) printf(" "); 49 PetscFunctionReturn(0); 50 } 51 52 static int processPacket(MLINK link, int indent) { 53 static int isHead = 0; 54 int tokenType = MLGetNext(link); 55 int ierr; 56 57 PetscFunctionBegin; 58 PetscCall(printIndent(indent)); 59 switch (tokenType) { 60 case MLTKFUNC: { 61 long numArguments; 62 int arg; 63 64 printf("Function:\n"); 65 MLGetArgCount(link, &numArguments); 66 /* Process head */ 67 printf(" Head:\n"); 68 isHead = 1; 69 ierr = processPacket(link, indent + 4); 70 if (ierr) PetscFunctionReturn(ierr); 71 isHead = 0; 72 /* Process arguments */ 73 printf(" Arguments:\n"); 74 for (arg = 0; arg < numArguments; arg++) PetscCall(processPacket(link, indent + 4)); 75 } break; 76 case MLTKSYM: { 77 const char *symbol; 78 79 MLGetSymbol(link, &symbol); 80 printf("Symbol: %s\n", symbol); 81 if (isHead && !strcmp(symbol, "Shutdown")) { 82 MLDisownSymbol(link, symbol); 83 PetscFunctionReturn(2); 84 } 85 MLDisownSymbol(link, symbol); 86 } break; 87 case MLTKINT: { 88 int i; 89 90 MLGetInteger(link, &i); 91 printf("Integer: %d\n", i); 92 } break; 93 case MLTKREAL: { 94 double r; 95 96 MLGetReal(link, &r); 97 printf("Real: %g\n", r); 98 } break; 99 case MLTKSTR: { 100 const char *string; 101 102 MLGetString(link, &string); 103 printf("String: %s\n", string); 104 MLDisownString(link, string); 105 } break; 106 default: 107 printf("Unknown code %d\n", tokenType); 108 MLClearError(link); 109 fprintf(stderr, "ERROR: %s\n", (char *)MLErrorMessage(link)); 110 PetscFunctionReturn(1); 111 } 112 PetscFunctionReturn(0); 113 } 114 115 static int processPackets(MLINK link) { 116 int packetType; 117 int loop = 1; 118 int errors = 0; 119 int err; 120 121 PetscFunctionBegin; 122 while (loop) { 123 while ((packetType = MLNextPacket(link)) && (packetType != RETURNPKT)) { 124 switch (packetType) { 125 case BEGINDLGPKT: printf("Begin dialog packet\n"); break; 126 case CALLPKT: printf("Call packet\n"); break; 127 case DISPLAYPKT: printf("Display packet\n"); break; 128 case DISPLAYENDPKT: printf("Display end packet\n"); break; 129 case ENDDLGPKT: printf("End dialog packet\n"); break; 130 case ENTERTEXTPKT: printf("Enter text packet\n"); break; 131 case ENTEREXPRPKT: printf("Enter expression packet\n"); break; 132 case EVALUATEPKT: printf("Evaluate packet\n"); break; 133 case INPUTPKT: printf("Input packet\n"); break; 134 case INPUTNAMEPKT: printf("Input name packet\n"); break; 135 case INPUTSTRPKT: printf("Input string packet\n"); break; 136 case MENUPKT: printf("Menu packet\n"); break; 137 case MESSAGEPKT: printf("Message packet\n"); break; 138 case OUTPUTNAMEPKT: printf("Output name packet\n"); break; 139 case RESUMEPKT: printf("Resume packet\n"); break; 140 case RETURNTEXTPKT: printf("Return text packet\n"); break; 141 case RETURNEXPRPKT: printf("Return expression packet\n"); break; 142 case SUSPENDPKT: printf("Suspend packet\n"); break; 143 case SYNTAXPKT: printf("Syntax packet\n"); break; 144 case TEXTPKT: printf("Text packet\n"); break; 145 } 146 MLNewPacket(link); 147 } 148 149 /* Got a Return packet */ 150 if (!packetType) { 151 MLClearError(link); 152 printf("ERROR: %s\n", (char *)MLErrorMessage(link)); 153 errors++; 154 } else if (packetType == RETURNPKT) { 155 err = processPacket(link, 0); 156 PetscCheck(err != 1, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error returned from Mathematica"); 157 if (err == 2) loop = 0; 158 } else { 159 fprintf(stderr, "Invalid packet type %d\n", packetType); 160 loop = 0; 161 } 162 if (errors > 10) loop = 0; 163 } 164 PetscFunctionReturn(0); 165 } 166 167 static int cleanupConnection(MLENV env, MLINK link) { 168 PetscFunctionBegin; 169 MLClose(link); 170 MLDeinitialize(env); 171 PetscFunctionReturn(0); 172 } 173 174 int main(int argc, char *argv[]) { 175 MLENV env; 176 MLINK link; 177 int ierr; 178 179 PetscCall(PetscInitialize(&argc, &argv, NULL, help)); 180 PetscCall(setupConnection(&env, &link, "192.168.119.1", MATHEMATICA_LINK_CONNECT)); 181 PetscCall(processPackets(link)); 182 PetscCall(cleanupConnection(env, link)); 183 PetscCall(PetscFinalize()); 184 return (ierr); 185 } 186