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