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
setupConnection(MLENV * env,MLINK * link,const char * linkhost,LinkMode 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;
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(PETSC_SUCCESS);
49 }
50
printIndent(int indent)51 static PetscErrorCode printIndent(int indent)
52 {
53 int i;
54
55 PetscFunctionBegin;
56 for (i = 0; i < indent; i++) printf(" ");
57 PetscFunctionReturn(PETSC_SUCCESS);
58 }
59
processPacket(MLINK link,int indent,int * result)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(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;
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(PETSC_SUCCESS);
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(PETSC_SUCCESS);
122 }
123 PetscFunctionReturn(PETSC_SUCCESS);
124 }
125
processPackets(MLINK link)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(PETSC_SUCCESS);
216 }
217
cleanupConnection(MLENV env,MLINK link)218 static PetscErrorCode cleanupConnection(MLENV env, MLINK link)
219 {
220 PetscFunctionBegin;
221 MLClose(link);
222 MLDeinitialize(env);
223 PetscFunctionReturn(PETSC_SUCCESS);
224 }
225
main(int argc,char * argv[])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