Annotation of OpenXM/src/ox_math/mlo.c, Revision 1.1
1.1 ! ohara 1: /* -*- mode: C; coding: euc-japan -*- */
! 2: /* $OpenXM$ */
! 3:
! 4: /* Open Mathematica サーバ */
! 5: /* ファイルディスクリプタ 3, 4 は open されていると仮定して動作する. */
! 6:
! 7: /* MathLink との通信部分 */
! 8:
! 9: #include <stdio.h>
! 10: #include <stdlib.h>
! 11: #include <unistd.h>
! 12: #include <gmp.h>
! 13: #include <mathlink.h>
! 14: #include "ox.h"
! 15: #include "parse.h"
! 16: #include "serv2.h"
! 17:
! 18: int flag_mlo_symbol = FLAG_MLTKSYM_IS_INDETERMINATE;
! 19:
! 20: /* MLINK はポインタ型. */
! 21: MLINK stdlink;
! 22:
! 23: typedef cmo mlo;
! 24: typedef cmo_string mlo_string;
! 25: typedef cmo_zz mlo_zz;
! 26:
! 27: mlo *receive_mlo_zz()
! 28: {
! 29: char *s;
! 30: mlo *m;
! 31:
! 32: MLGetString(stdlink, &s);
! 33: fprintf(stderr, "--debug: MLO == MLTKINT (%s).\n", s);
! 34: m = (mlo *)new_cmo_zz_set_string(s);
! 35: MLDisownString(stdlink, s);
! 36: return m;
! 37: }
! 38:
! 39: mlo *receive_mlo_string()
! 40: {
! 41: char *s;
! 42: mlo *m;
! 43: MLGetString(stdlink, &s);
! 44: fprintf(stderr, "--debug: MLO == MLTKSTR (\"%s\").\n", s);
! 45: m = (cmo *)new_cmo_string(s);
! 46: MLDisownString(stdlink, s);
! 47: return m;
! 48: }
! 49:
! 50: cmo *receive_mlo_function()
! 51: {
! 52: char *s;
! 53: cmo *m;
! 54: cmo *ob;
! 55: int i,n;
! 56:
! 57: MLGetFunction(stdlink, &s, &n);
! 58: fprintf(stderr, "--debug: MLO == MLTKFUNC (%s[#%d]).\n", s, n);
! 59: m = new_cmo_list();
! 60: append_cmo_list((cmo_list *)m, new_cmo_string(s));
! 61:
! 62: for (i=0; i<n; i++) {
! 63: fprintf(stderr, " --debug: arg[%d]\n", i);
! 64: fflush(stderr);
! 65: ob = receive_mlo();
! 66: append_cmo_list((cmo_list *)m, ob);
! 67: }
! 68:
! 69: MLDisownString(stdlink, s);
! 70: return m;
! 71: }
! 72:
! 73: mlo_function *new_mlo_function(char *function)
! 74: {
! 75: mlo_function *c = malloc(sizeof(mlo_function));
! 76: c->tag = MLO_FUNCTION;
! 77: c->length = 0;
! 78: c->head->next = NULL;
! 79: c->function = function;
! 80: return c;
! 81: }
! 82:
! 83: cmo *receive_mlo_function_newer()
! 84: {
! 85: char *s;
! 86: mlo_function *m;
! 87: cmo *ob;
! 88: int i,n;
! 89:
! 90: MLGetFunction(stdlink, &s, &n);
! 91: #ifdef DEBUG
! 92: fprintf(stderr, "--debug: MLO == MLTKFUNC, (%s[#%d])\n", s, n);
! 93: #endif
! 94: m = new_mlo_function(s);
! 95: for (i=0; i<n; i++) {
! 96: fprintf(stderr, "--debug: arg[%d]\n", i);
! 97: fflush(stderr);
! 98: ob = receive_mlo();
! 99: append_cmo_list((cmo_list *)m, ob);
! 100: }
! 101:
! 102: MLDisownString(stdlink, s);
! 103: return (cmo *)m;
! 104: }
! 105:
! 106: cmo *receive_mlo_symbol()
! 107: {
! 108: cmo *ob;
! 109: char *s;
! 110:
! 111: MLGetSymbol(stdlink, &s);
! 112: #ifdef DEBUG
! 113: fprintf(stderr, "--debug: MLO == MLTKSYM, (%s).\n", s);
! 114: #endif
! 115: if(flag_mlo_symbol == FLAG_MLTKSYM_IS_INDETERMINATE) {
! 116: ob = new_cmo_indeterminate(new_cmo_string(s));
! 117: }else {
! 118: ob = new_cmo_string(s);
! 119: }
! 120: MLDisownString(stdlink, s);
! 121: return ob;
! 122: }
! 123:
! 124: /* Mathematica を起動する. */
! 125: int ml_init()
! 126: {
! 127: int argc = 2;
! 128: char *argv[] = {"-linkname", "math -mathlink"};
! 129:
! 130: if(MLInitialize(NULL) == NULL
! 131: || (stdlink = MLOpen(argc, argv)) == NULL) {
! 132: fprintf(stderr, "Mathematica Kernel not found.\n");
! 133: exit(1);
! 134: }
! 135: return 0;
! 136: }
! 137:
! 138: int ml_exit()
! 139: {
! 140: /* quit Mathematica then close the link */
! 141: MLPutFunction(stdlink, "Exit", 0);
! 142: MLClose(stdlink);
! 143: }
! 144:
! 145: cmo *ml_get_object()
! 146: {
! 147: /* skip any packets before the first ReturnPacket */
! 148: while (MLNextPacket(stdlink) != RETURNPKT) {
! 149: usleep(10);
! 150: MLNewPacket(stdlink);
! 151: }
! 152: return receive_mlo();
! 153: }
! 154:
! 155: cmo *receive_mlo()
! 156: {
! 157: char *s;
! 158: int type;
! 159:
! 160: switch(type = MLGetNext(stdlink)) {
! 161: case MLTKINT:
! 162: return receive_mlo_zz();
! 163: case MLTKSTR:
! 164: return receive_mlo_string();
! 165: case MLTKREAL:
! 166: /* double はまだ... */
! 167: fprintf(stderr, "--debug: MLO == MLTKREAL.\n");
! 168: MLGetString(stdlink, &s);
! 169: return (cmo *)new_cmo_string(s);
! 170: case MLTKSYM:
! 171: return receive_mlo_symbol();
! 172: case MLTKFUNC:
! 173: return receive_mlo_function();
! 174: case MLTKERR:
! 175: fprintf(stderr, "--debug: MLO == MLTKERR.\n");
! 176: return (cmo *)make_error_object(ERROR_ID_FAILURE_MLINK, new_cmo_null());
! 177: default:
! 178: fprintf(stderr, "--debug: MLO(%d) is unknown.\n", type);
! 179: MLGetString(stdlink, &s);
! 180: fprintf(stderr, "--debug: \"%s\"\n", s);
! 181: return (cmo *)new_cmo_string(s);
! 182: }
! 183: }
! 184:
! 185: int send_mlo_int32(cmo *m)
! 186: {
! 187: MLPutInteger(stdlink, ((cmo_int32 *)m)->i);
! 188: }
! 189:
! 190: int send_mlo_string(cmo *m)
! 191: {
! 192: char *s = ((cmo_string *)m)->s;
! 193: MLPutString(stdlink, s);
! 194: }
! 195:
! 196: int send_mlo_zz(cmo *m)
! 197: {
! 198: char *s;
! 199: MLPutFunction(stdlink, "ToExpression", 1);
! 200: s = convert_cmo_to_string(m);
! 201: MLPutString(stdlink, s);
! 202: }
! 203:
! 204: int send_mlo_list(cmo *c)
! 205: {
! 206: char *s;
! 207: cell *cp = ((cmo_list *)c)->head;
! 208: int len = length_cmo_list((cmo_list *)c);
! 209:
! 210: MLPutFunction(stdlink, "List", len);
! 211: while(cp->next != NULL) {
! 212: send_mlo(cp->cmo);
! 213: cp = cp->next;
! 214: }
! 215: }
! 216:
! 217: int ml_sendObject(cmo *m)
! 218: {
! 219: send_mlo(m);
! 220: MLEndPacket(stdlink);
! 221: }
! 222:
! 223: int send_mlo(cmo *m)
! 224: {
! 225: char *s;
! 226: switch(m->tag) {
! 227: case CMO_INT32:
! 228: send_mlo_int32(m);
! 229: break;
! 230: case CMO_ZERO:
! 231: case CMO_NULL:
! 232: send_mlo_int32(new_cmo_int32(0));
! 233: break;
! 234: case CMO_STRING:
! 235: send_mlo_string(m);
! 236: break;
! 237: case CMO_LIST:
! 238: send_mlo_list(m);
! 239: break;
! 240: case CMO_MATHCAP:
! 241: send_mlo(((cmo_mathcap *)m)->ob);
! 242: break;
! 243: case CMO_ZZ:
! 244: send_mlo_zz(m);
! 245: break;
! 246: default:
! 247: MLPutFunction(stdlink, "ToExpression", 1);
! 248: s = convert_cmo_to_string(m);
! 249: MLPutString(stdlink, s);
! 250: break;
! 251: }
! 252: }
! 253:
! 254: int ml_evaluateStringByLocalParser(char *str)
! 255: {
! 256: MLPutFunction(stdlink, "ToExpression", 1);
! 257: MLPutString(stdlink, str);
! 258: MLEndPacket(stdlink);
! 259: }
! 260:
! 261: int ml_executeFunction(char *function, int argc, cmo *argv[])
! 262: {
! 263: int i;
! 264: MLPutFunction(stdlink, function, argc);
! 265: for (i=0; i<argc; i++) {
! 266: send_mlo(argv[i]);
! 267: }
! 268: MLEndPacket(stdlink);
! 269: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to mlo.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_math