Return to oxmaples.c CVS log

Up to [local] / OpenXM / src / ox_maple

OpenXM Maple server

/* $OpenXM: OpenXM/src/ox_maple/oxmaples.c,v 1.1 2008/09/19 13:01:05 iwane Exp $ */
/************************************************************************
 *
 * float $B$KBP1~$G$-$F$$$J$$(B.
 *
 *
 * $B0J2<BP1~$7$?$b$N(B
 *  - $B@0?t(B, $BB?9`<0(B, $B%j%9%H(B
 * 
 *
 *********************************************************************** */

#include <stdio.h>
#include <string.h>

#include "oxstack.h"
#include "oxserv.h"


#include "maplec.h"
#include "oxmaple.h"

#define DPRINTF(x)	printf x; fflush(stdout)

/*==========================================================================*
 * Block interrupt input
 *==========================================================================*/

#define BLOCK_NEW_CMO()
#define UNBLOCK_NEW_CMO()

/*==========================================================================*
 * Gloval 
 *==========================================================================*/
static MKernelVector kv;  /* Maple kernel handle */

static cmo_string *maple_error_message;


/*==========================================================================*
 * wrapper
 *==========================================================================*/
cmo	*	
convert_maple2cmo_(ALGEB a)
{
	return (convert_maple2cmo(kv, a));
}

char	*
convert_maple2str_(ALGEB a) 
{
	return (convert_maple2str(kv, a));
}


/*==========================================================================*
 * main
 *==========================================================================*/
/* callback used for directing result output */


static void M_DECL textCallBack( void *data, int tag, char *output )
{
	printf("%s\n",output);
}


static void
oxmpl_print_err(void *data, int offset, char *msg)
{
	fprintf(stderr, "data=%p, offset=%d\n", data, offset);fflush(stderr);
	fprintf(stderr, "msg=%s\n", msg);fflush(stderr);
	maple_error_message = new_cmo_string(msg);
}

int oxmpl_init(int argc, char *argv[])
{
	
	char err[2048];  /* command input and error string buffers */
	MCallBackVectorDesc cb = {  textCallBack,
		oxmpl_print_err,   /* errorCallBack not used */
		0,   /* statusCallBack not used */
		0,   /* readLineCallBack not used */
		0,   /* redirectCallBack not used */
		0,   /* streamCallBack not used */
		0,   /* queryInterrupt not used */
		0	/* callBackCallBack not used */
	};
	ALGEB r;  /* Maple data-structures */
   


	/* initialize Maple */
	if( (kv=StartMaple(argc,argv,&cb,NULL,NULL,err)) == NULL ) {
		printf("Fatal error, %s\n",err);
		return (16);
	}

	/* example 1: find out where Maple is installed */
	r = MapleKernelOptions(kv,"mapledir",NULL);
	if( IsMapleString(kv,r) ) {
		printf("Maple directory = \"%s\"\n\n",MapleToString(kv,r));
		return (16);
	}

	return (0);
}




static inline void
convert_to_maple(oxstack_node *p)
{
	if (p->p == NULL) {
		p->p = convert_cmo_to_maple(kv, p->c, NULL);
	}
}

/*==========================================================================*
 * user function
 *==========================================================================*/

/****************************************************************************
 * add
 ****************************************************************************/
oxstack_node *
oxmpl_add(oxstack_node **arg, int argc)
{
	oxstack_node *p[2], *ans;
	const char *s[2];
	char *buf;
	ALGEB alg;
	int i;
	int len;

printf("call funcion 'add'\n");
	len = 0;
	for (i = 0; i < argc; i++) {
		convert_to_maple(arg[i]);
		p[i] = arg[i];
		s[i] = MapleToString(kv, p[i]->p);
		len += strlen(s[i]) + 1;
	}

	buf = MapleAlloc(kv, len);
	sprintf(buf, "%s+%s:", s[0], s[1]);


	alg = EvalMapleStatement(kv, buf);

	ans = oxstack_node_init(NULL);
	ans->p = alg;

	return (ans);
}

/****************************************************************************
 * whattype
 ****************************************************************************/
oxstack_node *
oxmpl_whattype(oxstack_node **arg, int argc)
{
	oxstack_node *ans;
	char *s;
	ALGEB alg;
	cmo *c;

	ans = oxstack_node_init(arg[0]->c);
	ans->p = arg[0]->p;
	oxstack_push(ans);

	if (arg[0]->p == NULL) {
		s = GC_MALLOC(30);
		sprintf(s, "cmo(%d=0x%08x)", arg[0]->c->tag, arg[0]->c->tag);
	} else {
		alg = EvalMapleStatement(kv, "whattype:");
		alg = EvalMapleProc(kv, alg, 1, arg[0]->p);
		alg = MapleALGEB_SPrintf(kv, "%a", alg);
		s = MapleToString(kv, alg);
	}

	c = (cmo *)new_cmo_string(s);
	ans = oxstack_node_init(c);
	return (ans);
}


/****************************************************************************
 * sleep
 ****************************************************************************/
#include <unistd.h>

oxstack_node *
oxmpl_sleep(oxstack_node **arg, int argc)
{
	oxstack_node *ans;
	int i;
	mpz_ptr len;
	mpz_t m;
	cmo_error2 *err;

printf("call funcion 'sleep'\n");
	for (i = 0; i < argc; i++) {
		if (arg[i]->c->tag != CMO_INT32 &&
		    arg[i]->c->tag != CMO_ZZ) {
			err = new_cmo_error2((cmo *)new_cmo_string("invalid 1st argument: not integer"));
			ans = oxstack_node_init((cmo *)err);
			return (ans);
			
		}
	}

	if (arg[0]->c->tag == CMO_ZZ) {
		len = ((cmo_zz *)arg[0]->c)->mpz;
	} else {
		mpz_init(m);
		len = m;
		mpz_set_si(m, ((cmo_int32 *)arg[0]->c)->i);
	}
	if (mpz_cmp_si(len, 0) > 0) {
		if (mpz_cmp_si(len, 0x1000000) > 0) {
			/* too large */
			i = 0x10000000;
		} else {
			i = (mpz_get_ui(len));
		}
		printf("sleep(%d=0x%x)\n", i, i);
		sleep(i);
	}

	ans = oxstack_node_init(arg[0]->c);
	ans->p = arg[0]->p;

	return (ans);
}

/****************************************************************************
 * func
 * maple $B>e$NG$0U$N4X?t$r<B9T$9$k(B
 ****************************************************************************/
oxstack_node *
oxmpl_func(oxstack_node **arg, int argc)
{
	oxstack_node *ans;
	oxstack_node **args2;
	ALGEB *args3;
	char *buf, *ff;
	cmo_error2 *err;
	ALGEB alg;
	ALGEB f;
	int i;

printf("call funcion 'func' argc=%d\n", argc);

	if (arg[0]->c->tag != CMO_STRING) {
		err = new_cmo_error2((cmo *)new_cmo_string("invalid 1st argument: not string"));
		ans = oxstack_node_init((cmo *)err);
		return (ans);
	}

	for (i = 1; i < argc; i++) {
		convert_to_maple(arg[i]);
		if (arg[i]->p == NULL) {
			err = new_cmo_error2((cmo *)new_cmo_string("convert failed"));
			ans = oxstack_node_init((cmo *)err);
			return (ans);
			
		}
	}

	ff = ((cmo_string *)arg[0]->c)->s;
	buf = MapleAlloc(kv, strlen(ff) + 10);
	sprintf(buf, "%s:", ff);
	f = EvalMapleStatement(kv, buf);


#define ARG_N 20
	args2 = MapleAlloc(kv, sizeof(oxstack_node *) * ARG_N);
	for (i = 0; i < argc - 1; i++) {
		args2[i] = arg[i+1];
	}
	for (; i < ARG_N; i++) {
		args2[i] = NULL;
	}

	/* $B2?8N$+$o$+$i$J$$$,$3$&$d$i$J$$$HF0$+$J$$(B. */
	args3 = MapleAlloc(kv, sizeof(ALGEB) * ARG_N);
	for (i = 0; i < argc - 1; i++) {
		args3[i] = args2[i]->p;
	}


	/* $B$I$&$9$C$Z$+$J(B */
	if (argc < ARG_N) {
#define ARG(n) args3[n]
		alg = EvalMapleProc(kv, f, argc - 1, 
		    ARG( 0), ARG( 1), ARG( 2), ARG( 3), ARG( 4), 
		    ARG( 5), ARG( 6), ARG( 7), ARG( 8), ARG( 9), 
		    ARG(10), ARG(11), ARG(12), ARG(13), ARG(14),
		    ARG(15), ARG(16), ARG(17), ARG(18), ARG(19));
printf("EvalMapleProg: alg=%p\n", alg);
		if (alg == NULL) {
			err = new_cmo_error2((cmo *)maple_error_message);
		}
#undef ARG
	} else {
		/* .... @@TODO */
		alg = NULL;
		err = new_cmo_error2((cmo *)new_cmo_string(
		    "too much argument"));
	}


	ans = oxstack_node_init(NULL);
	ans->p = alg;
	if (alg == NULL) {
		ans->c = (cmo *)err;
	}

	MapleDispose(kv, (ALGEB)buf);
	MapleDispose(kv, (ALGEB)args2);

	return (ans);
}



void 
oxmpl_executeStringParser(char *str)
{
	ALGEB alg;
	oxstack_node *ans;

	DPRINTF(("StringParser start [%s]\n", str));
	alg = EvalMapleStatement(kv, str);

	DPRINTF(("end maple eval\n"));
	ans = oxstack_node_init(NULL);
	ans->p = alg;

	oxstack_push(ans);
}


/*==========================================================================*
 * debug
 *==========================================================================*/
#include <unistd.h>
#include <stdarg.h>
void
oxmpl_debug_callfunc(
	const char *funcname, 
	int argc, ...)
{
	int i;
	va_list ap;
	ALGEB name;
	ALGEB *argv;
	char buf[1024];

	argv = GC_MALLOC(sizeof(ALGEB) * 10);

	sprintf(buf, "%s:", funcname);
	name = EvalMapleStatement(kv, buf);
	
	va_start(ap, argc);
	for (i = 0; i < argc; i++) {
		sprintf(buf, "%s:", va_arg(ap, char *));
		argv[i] = EvalMapleStatement(kv, buf);
	}
	for (; i < 10; i++) {
		argv[i] = NULL;
	}
	va_end(ap);

	
printf("eval proc\n");
	name = EvalMapleProc(kv, name, argc, argv[0], argv[1], argv[2]);
MapleALGEB_Printf(kv, "ret = %a\n", name);
}