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