Annotation of OpenXM/src/ox_maple/oxmaples.c, Revision 1.1
1.1 ! iwane 1: /* $OpenXM$ */
! 2: /************************************************************************
! 3: *
! 4: * float $B$KBP1~$G$-$F$$$J$$(B.
! 5: *
! 6: *
! 7: * $B0J2<BP1~$7$?$b$N(B
! 8: * - $B@0?t(B, $BB?9`<0(B, $B%j%9%H(B
! 9: *
! 10: *
! 11: *********************************************************************** */
! 12:
! 13: #include <stdio.h>
! 14: #include <string.h>
! 15:
! 16: #include "oxstack.h"
! 17: #include "oxserv.h"
! 18:
! 19:
! 20: #include "maplec.h"
! 21: #include "oxmaple.h"
! 22:
! 23: #define DPRINTF(x) printf x; fflush(stdout)
! 24:
! 25: /*==========================================================================*
! 26: * Block interrupt input
! 27: *==========================================================================*/
! 28:
! 29: #define BLOCK_NEW_CMO()
! 30: #define UNBLOCK_NEW_CMO()
! 31:
! 32: /*==========================================================================*
! 33: * Gloval
! 34: *==========================================================================*/
! 35: static MKernelVector kv; /* Maple kernel handle */
! 36:
! 37: static cmo_string *maple_error_message;
! 38:
! 39:
! 40: /*==========================================================================*
! 41: * wrapper
! 42: *==========================================================================*/
! 43: cmo *
! 44: convert_maple2cmo_(ALGEB a)
! 45: {
! 46: return (convert_maple2cmo(kv, a));
! 47: }
! 48:
! 49: char *
! 50: convert_maple2str_(ALGEB a)
! 51: {
! 52: return (convert_maple2str(kv, a));
! 53: }
! 54:
! 55:
! 56: /*==========================================================================*
! 57: * main
! 58: *==========================================================================*/
! 59: /* callback used for directing result output */
! 60:
! 61:
! 62: static void M_DECL textCallBack( void *data, int tag, char *output )
! 63: {
! 64: printf("%s\n",output);
! 65: }
! 66:
! 67:
! 68: static void
! 69: oxmpl_print_err(void *data, int offset, char *msg)
! 70: {
! 71: fprintf(stderr, "data=%p, offset=%d\n", data, offset);fflush(stderr);
! 72: fprintf(stderr, "msg=%s\n", msg);fflush(stderr);
! 73: maple_error_message = new_cmo_string(msg);
! 74: }
! 75:
! 76: int oxmpl_init(int argc, char *argv[])
! 77: {
! 78:
! 79: char err[2048]; /* command input and error string buffers */
! 80: MCallBackVectorDesc cb = { textCallBack,
! 81: oxmpl_print_err, /* errorCallBack not used */
! 82: 0, /* statusCallBack not used */
! 83: 0, /* readLineCallBack not used */
! 84: 0, /* redirectCallBack not used */
! 85: 0, /* streamCallBack not used */
! 86: 0, /* queryInterrupt not used */
! 87: 0 /* callBackCallBack not used */
! 88: };
! 89: ALGEB r; /* Maple data-structures */
! 90:
! 91:
! 92:
! 93: /* initialize Maple */
! 94: if( (kv=StartMaple(argc,argv,&cb,NULL,NULL,err)) == NULL ) {
! 95: printf("Fatal error, %s\n",err);
! 96: return (16);
! 97: }
! 98:
! 99: /* example 1: find out where Maple is installed */
! 100: r = MapleKernelOptions(kv,"mapledir",NULL);
! 101: if( IsMapleString(kv,r) ) {
! 102: printf("Maple directory = \"%s\"\n\n",MapleToString(kv,r));
! 103: return (16);
! 104: }
! 105:
! 106: return (0);
! 107: }
! 108:
! 109:
! 110:
! 111:
! 112: static inline void
! 113: convert_to_maple(oxstack_node *p)
! 114: {
! 115: if (p->p == NULL) {
! 116: p->p = convert_cmo_to_maple(kv, p->c, NULL);
! 117: }
! 118: }
! 119:
! 120: /*==========================================================================*
! 121: * user function
! 122: *==========================================================================*/
! 123:
! 124: /****************************************************************************
! 125: * add
! 126: ****************************************************************************/
! 127: oxstack_node *
! 128: oxmpl_add(oxstack_node **arg, int argc)
! 129: {
! 130: oxstack_node *p[2], *ans;
! 131: const char *s[2];
! 132: char *buf;
! 133: ALGEB alg;
! 134: int i;
! 135: int len;
! 136:
! 137: printf("call funcion 'add'\n");
! 138: len = 0;
! 139: for (i = 0; i < argc; i++) {
! 140: convert_to_maple(arg[i]);
! 141: p[i] = arg[i];
! 142: s[i] = MapleToString(kv, p[i]->p);
! 143: len += strlen(s[i]) + 1;
! 144: }
! 145:
! 146: buf = MapleAlloc(kv, len);
! 147: sprintf(buf, "%s+%s:", s[0], s[1]);
! 148:
! 149:
! 150: alg = EvalMapleStatement(kv, buf);
! 151:
! 152: ans = oxstack_node_init(NULL);
! 153: ans->p = alg;
! 154:
! 155: return (ans);
! 156: }
! 157:
! 158: /****************************************************************************
! 159: * whattype
! 160: ****************************************************************************/
! 161: oxstack_node *
! 162: oxmpl_whattype(oxstack_node **arg, int argc)
! 163: {
! 164: oxstack_node *ans;
! 165: char *s;
! 166: ALGEB alg;
! 167: cmo *c;
! 168:
! 169: ans = oxstack_node_init(arg[0]->c);
! 170: ans->p = arg[0]->p;
! 171: oxstack_push(ans);
! 172:
! 173: if (arg[0]->p == NULL) {
! 174: s = GC_MALLOC(30);
! 175: sprintf(s, "cmo(%d=0x%08x)", arg[0]->c->tag, arg[0]->c->tag);
! 176: } else {
! 177: alg = EvalMapleStatement(kv, "whattype:");
! 178: alg = EvalMapleProc(kv, alg, 1, arg[0]->p);
! 179: alg = MapleALGEB_SPrintf(kv, "%a", alg);
! 180: s = MapleToString(kv, alg);
! 181: }
! 182:
! 183: c = (cmo *)new_cmo_string(s);
! 184: ans = oxstack_node_init(c);
! 185: return (ans);
! 186: }
! 187:
! 188:
! 189: /****************************************************************************
! 190: * sleep
! 191: ****************************************************************************/
! 192: #include <unistd.h>
! 193:
! 194: oxstack_node *
! 195: oxmpl_sleep(oxstack_node **arg, int argc)
! 196: {
! 197: oxstack_node *ans;
! 198: int i;
! 199: mpz_ptr len;
! 200: mpz_t m;
! 201: cmo_error2 *err;
! 202:
! 203: printf("call funcion 'sleep'\n");
! 204: for (i = 0; i < argc; i++) {
! 205: if (arg[i]->c->tag != CMO_INT32 &&
! 206: arg[i]->c->tag != CMO_ZZ) {
! 207: err = new_cmo_error2((cmo *)new_cmo_string("invalid 1st argument: not integer"));
! 208: ans = oxstack_node_init((cmo *)err);
! 209: return (ans);
! 210:
! 211: }
! 212: }
! 213:
! 214: if (arg[0]->c->tag == CMO_ZZ) {
! 215: len = ((cmo_zz *)arg[0]->c)->mpz;
! 216: } else {
! 217: mpz_init(m);
! 218: len = m;
! 219: mpz_set_si(m, ((cmo_int32 *)arg[0]->c)->i);
! 220: }
! 221: if (mpz_cmp_si(len, 0) > 0) {
! 222: if (mpz_cmp_si(len, 0x1000000) > 0) {
! 223: /* too large */
! 224: i = 0x10000000;
! 225: } else {
! 226: i = (mpz_get_ui(len));
! 227: }
! 228: printf("sleep(%d=0x%x)\n", i, i);
! 229: sleep(i);
! 230: }
! 231:
! 232: ans = oxstack_node_init(arg[0]->c);
! 233: ans->p = arg[0]->p;
! 234:
! 235: return (ans);
! 236: }
! 237:
! 238: /****************************************************************************
! 239: * func
! 240: * maple $B>e$NG$0U$N4X?t$r<B9T$9$k(B
! 241: ****************************************************************************/
! 242: oxstack_node *
! 243: oxmpl_func(oxstack_node **arg, int argc)
! 244: {
! 245: oxstack_node *ans;
! 246: oxstack_node **args2;
! 247: ALGEB *args3;
! 248: char *buf, *ff;
! 249: cmo_error2 *err;
! 250: ALGEB alg;
! 251: ALGEB f;
! 252: int i;
! 253:
! 254: printf("call funcion 'func' argc=%d\n", argc);
! 255:
! 256: if (arg[0]->c->tag != CMO_STRING) {
! 257: err = new_cmo_error2((cmo *)new_cmo_string("invalid 1st argument: not string"));
! 258: ans = oxstack_node_init((cmo *)err);
! 259: return (ans);
! 260: }
! 261:
! 262: for (i = 1; i < argc; i++) {
! 263: convert_to_maple(arg[i]);
! 264: if (arg[i]->p == NULL) {
! 265: err = new_cmo_error2((cmo *)new_cmo_string("convert failed"));
! 266: ans = oxstack_node_init((cmo *)err);
! 267: return (ans);
! 268:
! 269: }
! 270: }
! 271:
! 272: ff = ((cmo_string *)arg[0]->c)->s;
! 273: buf = MapleAlloc(kv, strlen(ff) + 10);
! 274: sprintf(buf, "%s:", ff);
! 275: f = EvalMapleStatement(kv, buf);
! 276:
! 277:
! 278: #define ARG_N 20
! 279: args2 = MapleAlloc(kv, sizeof(oxstack_node *) * ARG_N);
! 280: for (i = 0; i < argc - 1; i++) {
! 281: args2[i] = arg[i+1];
! 282: }
! 283: for (; i < ARG_N; i++) {
! 284: args2[i] = NULL;
! 285: }
! 286:
! 287: /* $B2?8N$+$o$+$i$J$$$,$3$&$d$i$J$$$HF0$+$J$$(B. */
! 288: args3 = MapleAlloc(kv, sizeof(ALGEB) * ARG_N);
! 289: for (i = 0; i < argc - 1; i++) {
! 290: args3[i] = args2[i]->p;
! 291: }
! 292:
! 293:
! 294: /* $B$I$&$9$C$Z$+$J(B */
! 295: if (argc < ARG_N) {
! 296: #define ARG(n) args3[n]
! 297: alg = EvalMapleProc(kv, f, argc - 1,
! 298: ARG( 0), ARG( 1), ARG( 2), ARG( 3), ARG( 4),
! 299: ARG( 5), ARG( 6), ARG( 7), ARG( 8), ARG( 9),
! 300: ARG(10), ARG(11), ARG(12), ARG(13), ARG(14),
! 301: ARG(15), ARG(16), ARG(17), ARG(18), ARG(19));
! 302: printf("EvalMapleProg: alg=%p\n", alg);
! 303: if (alg == NULL) {
! 304: err = new_cmo_error2((cmo *)maple_error_message);
! 305: }
! 306: #undef ARG
! 307: } else {
! 308: /* .... @@TODO */
! 309: alg = NULL;
! 310: err = new_cmo_error2((cmo *)new_cmo_string(
! 311: "too much argument"));
! 312: }
! 313:
! 314:
! 315: ans = oxstack_node_init(NULL);
! 316: ans->p = alg;
! 317: if (alg == NULL) {
! 318: ans->c = (cmo *)err;
! 319: }
! 320:
! 321: MapleDispose(kv, (ALGEB)buf);
! 322: MapleDispose(kv, (ALGEB)args2);
! 323:
! 324: return (ans);
! 325: }
! 326:
! 327:
! 328:
! 329: void
! 330: oxmpl_executeStringParser(char *str)
! 331: {
! 332: ALGEB alg;
! 333: oxstack_node *ans;
! 334:
! 335: DPRINTF(("StringParser start [%s]\n", str));
! 336: alg = EvalMapleStatement(kv, str);
! 337:
! 338: DPRINTF(("end maple eval\n"));
! 339: ans = oxstack_node_init(NULL);
! 340: ans->p = alg;
! 341:
! 342: oxstack_push(ans);
! 343: }
! 344:
! 345:
! 346: /*==========================================================================*
! 347: * debug
! 348: *==========================================================================*/
! 349: #include <unistd.h>
! 350: #include <stdarg.h>
! 351: void
! 352: oxmpl_debug_callfunc(
! 353: const char *funcname,
! 354: int argc, ...)
! 355: {
! 356: int i;
! 357: va_list ap;
! 358: ALGEB name;
! 359: ALGEB *argv;
! 360: char buf[1024];
! 361:
! 362: argv = GC_MALLOC(sizeof(ALGEB) * 10);
! 363:
! 364: sprintf(buf, "%s:", funcname);
! 365: name = EvalMapleStatement(kv, buf);
! 366:
! 367: va_start(ap, argc);
! 368: for (i = 0; i < argc; i++) {
! 369: sprintf(buf, "%s:", va_arg(ap, char *));
! 370: argv[i] = EvalMapleStatement(kv, buf);
! 371: }
! 372: for (; i < 10; i++) {
! 373: argv[i] = NULL;
! 374: }
! 375: va_end(ap);
! 376:
! 377:
! 378: printf("eval proc\n");
! 379: name = EvalMapleProc(kv, name, argc, argv[0], argv[1], argv[2]);
! 380: MapleALGEB_Printf(kv, "ret = %a\n", name);
! 381: }
! 382:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to oxmaples.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / ox_maple