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