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