Actual source code: runtime.c

  1: static const char help[] = "Tests PETSc -- Mathematica connection\n";
  2: #include <petscksp.h>
  3: #include <mathlink.h>

  5: typedef enum {
  6:   MATHEMATICA_LINK_CREATE,
  7:   MATHEMATICA_LINK_CONNECT,
  8:   MATHEMATICA_LINK_LAUNCH
  9: } LinkMode;

 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;

 19:   PetscFunctionBegin;
 20:   /* Link name */
 21:   argv[0] = "-linkname";
 22:   argv[1] = "8001";

 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;

 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:   }

 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(PETSC_SUCCESS);
 49: }

 51: static PetscErrorCode printIndent(int indent)
 52: {
 53:   int i;

 55:   PetscFunctionBegin;
 56:   for (i = 0; i < indent; i++) printf(" ");
 57:   PetscFunctionReturn(PETSC_SUCCESS);
 58: }

 60: static PetscErrorCode processPacket(MLINK link, int indent, int *result)
 61: {
 62:   static int isHead    = 0;
 63:   int        tokenType = MLGetNext(link);
 64:   int        ierr;

 66:   PetscFunctionBegin;
 67:   PetscCall(printIndent(indent));
 68:   switch (tokenType) {
 69:   case MLTKFUNC: {
 70:     long numArguments;
 71:     int  arg;

 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(PETSC_SUCCESS);
 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;

 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(PETSC_SUCCESS);
 94:     }
 95:     MLDisownSymbol(link, symbol);
 96:   } break;
 97:   case MLTKINT: {
 98:     int i;

100:     MLGetInteger(link, &i);
101:     printf("Integer: %d\n", i);
102:   } break;
103:   case MLTKREAL: {
104:     double r;

106:     MLGetReal(link, &r);
107:     printf("Real: %g\n", r);
108:   } break;
109:   case MLTKSTR: {
110:     const char *string;

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(PETSC_SUCCESS);
122:   }
123:   PetscFunctionReturn(PETSC_SUCCESS);
124: }

126: static PetscErrorCode processPackets(MLINK link)
127: {
128:   int packetType;
129:   int loop   = 1;
130:   int errors = 0;
131:   int err, result;

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:     }

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(PETSC_SUCCESS);
216: }

218: static PetscErrorCode cleanupConnection(MLENV env, MLINK link)
219: {
220:   PetscFunctionBegin;
221:   MLClose(link);
222:   MLDeinitialize(env);
223:   PetscFunctionReturn(PETSC_SUCCESS);
224: }

226: int main(int argc, char *argv[])
227: {
228:   MLENV env;
229:   MLINK link;

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: }