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 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 PetscErrorCode printIndent(int indent) { 45 int i; 46 47 PetscFunctionBegin; 48 for (i = 0; i < indent; i++) printf(" "); 49 PetscFunctionReturn(0); 50 } 51 52 static PetscErrorCode processPacket(MLINK link, int indent, int *result) { 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 PetscCall(processPacket(link, indent + 4, result)); 70 if (*result) PetscFunctionReturn(0); 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 *result = 2; 84 PetscFunctionReturn(0); 85 } 86 MLDisownSymbol(link, symbol); 87 } break; 88 case MLTKINT: { 89 int i; 90 91 MLGetInteger(link, &i); 92 printf("Integer: %d\n", i); 93 } break; 94 case MLTKREAL: { 95 double r; 96 97 MLGetReal(link, &r); 98 printf("Real: %g\n", r); 99 } break; 100 case MLTKSTR: { 101 const char *string; 102 103 MLGetString(link, &string); 104 printf("String: %s\n", string); 105 MLDisownString(link, string); 106 } break; 107 default: 108 printf("Unknown code %d\n", tokenType); 109 MLClearError(link); 110 fprintf(stderr, "ERROR: %s\n", (char *)MLErrorMessage(link)); 111 *result = 1; 112 PetscFunctionReturn(0); 113 } 114 PetscFunctionReturn(0); 115 } 116 117 static PetscErrorCode processPackets(MLINK link) { 118 int packetType; 119 int loop = 1; 120 int errors = 0; 121 int err, result; 122 123 PetscFunctionBegin; 124 while (loop) { 125 while ((packetType = MLNextPacket(link)) && (packetType != RETURNPKT)) { 126 switch (packetType) { 127 case BEGINDLGPKT: printf("Begin dialog packet\n"); break; 128 case CALLPKT: printf("Call packet\n"); break; 129 case DISPLAYPKT: printf("Display packet\n"); break; 130 case DISPLAYENDPKT: printf("Display end packet\n"); break; 131 case ENDDLGPKT: printf("End dialog packet\n"); break; 132 case ENTERTEXTPKT: printf("Enter text packet\n"); break; 133 case ENTEREXPRPKT: printf("Enter expression packet\n"); break; 134 case EVALUATEPKT: printf("Evaluate packet\n"); break; 135 case INPUTPKT: printf("Input packet\n"); break; 136 case INPUTNAMEPKT: printf("Input name packet\n"); break; 137 case INPUTSTRPKT: printf("Input string packet\n"); break; 138 case MENUPKT: printf("Menu packet\n"); break; 139 case MESSAGEPKT: printf("Message packet\n"); break; 140 case OUTPUTNAMEPKT: printf("Output name packet\n"); break; 141 case RESUMEPKT: printf("Resume packet\n"); break; 142 case RETURNTEXTPKT: printf("Return text packet\n"); break; 143 case RETURNEXPRPKT: printf("Return expression packet\n"); break; 144 case SUSPENDPKT: printf("Suspend packet\n"); break; 145 case SYNTAXPKT: printf("Syntax packet\n"); break; 146 case TEXTPKT: printf("Text packet\n"); break; 147 } 148 MLNewPacket(link); 149 } 150 151 /* Got a Return packet */ 152 if (!packetType) { 153 MLClearError(link); 154 printf("ERROR: %s\n", (char *)MLErrorMessage(link)); 155 errors++; 156 } else if (packetType == RETURNPKT) { 157 PetscCall(processPacket(link, result)); 158 if (result == 2) loop = 0; 159 } else { 160 fprintf(stderr, "Invalid packet type %d\n", packetType); 161 loop = 0; 162 } 163 if (errors > 10) loop = 0; 164 } 165 PetscFunctionReturn(0); 166 } 167 168 static PetscErrorCode cleanupConnection(MLENV env, MLINK link) { 169 PetscFunctionBegin; 170 MLClose(link); 171 MLDeinitialize(env); 172 PetscFunctionReturn(0); 173 } 174 175 int main(int argc, char *argv[]) { 176 MLENV env; 177 MLINK link; 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 0; 185 } 186