home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Education Sampler 1992 [NeXTSTEP]
/
Education_1992_Sampler.iso
/
NeXT
/
Misc
/
HigherEducationMailbox.mbox
/
Archives_provide_val_.attach
/
May_91
/
mathematica.360
< prev
next >
Wrap
Text File
|
1991-05-21
|
12KB
|
583 lines
Mathematica CallProcess linkage code
Q: What's the linkage code necessary for communicating with Mathematica using CallProcess?
A: Create the following two files.
(1) A file named mathlink.h, which is empty.
(2) A file named mathlink.c, consisting of the following:
#
/** External Functions for Use with CallProcess **/
/* Copyright 1988 Wolfram Research, Inc. */
#include <stdio.h>
#include <varargs.h>
#include <strings.h>
/* NB: We assume that the following file descriptors are used for comunication
between mathematica and the user program:
0 : Read pipe for program
1 : Write pipe to math
*/
#define ERROR -1
#define FALSE 0
#define TRUE 1
#define MATHREADPID 0
#define MATHWRITEPID 1
#define PKTSIZE 64
#define BUFSIZE (PKTSIZE * 10)
#define MAXARGSIZE 128
/* Buffer Identifiers */
#define IDENT_MAGIC '0'
#define IDENT_REQUEST '1'
#define IDENT_RESULT '2'
#define IDENT_INSTALL '3'
#define IDENT_CALL '4'
#define IDENT_ERROR '5'
#define IDENT_START '6'
#define IDENT_KILL '7'
/* Types (this corresponds to type table (typetab) below) */
#define T_INT 1
#define T_DOUBLE 2
#define T_CHARSTAR 3
/* Function Table */
struct FTABENT {
void (*ft_func)(); /* The function to call */
char *ft_name; /* The functions name */
unsigned char ft_ftype; /* The functions type */
struct FALIST *ft_falist; /* The functions argument list */
struct FTABENT *ft_nxt; /* Pointer to next ftab */
};
struct FALIST {
/* char *fa_name; /* Argument name */
unsigned char fa_atype; /* Argument type */
struct FALIST *fa_nxt; /* Pointer to next argument */
};
static char *typetab[] = {"", "int", "double", "char *", NULL};
static struct FTABENT *ftabbase = NULL;
MathInit() {
sendbuf(IDENT_MAGIC,"MathLinkedFile");
}
MathExec(cp)
register char *cp; {
sendbuf(IDENT_REQUEST,cp);
}
MathInstall(func,fname,ftype,argnames,argtypes)
void (*func)();
char *fname;
char *ftype;
char *argnames;
char *argtypes; {
register struct FTABENT *ftp;
register struct FALIST *fap;
register char *cp;
char *cp1;
int i = 0;
char instbuf[BUFSIZE];
static char *getcsfield();
if ((ftp = (struct FTABENT *)malloc(sizeof *ftp)) == NULL) {
/* Return Error */
}
ftp->ft_nxt = ftabbase;
ftabbase = ftp;
ftp->ft_func = func;
ftp->ft_name = fname;
if (!(ftp->ft_ftype = typelookup(ftype)))
return(FALSE);
outtypename(&i,instbuf,ftype,fname);
ftp->ft_falist = NULL;
while (cp = getcsfield(&argnames)) {
if ((fap = (struct FALIST *)malloc(sizeof *fap)) == NULL) {
/* Return Error */
}
fap->fa_nxt = ftp->ft_falist;
ftp->ft_falist = fap;
cp1 = cp;
while (*cp != '\0' && *cp != '_')
cp++;
if (*cp == '\0')
outtypename(&i,instbuf,"",cp1);
else {
*cp++ = '\0';
outtypename(&i,instbuf,cp,cp1);
}
if (!(cp = getcsfield(&argtypes))) {
/* Return Error */
}
if (!(fap->fa_atype = typelookup(cp))) {
/* Return Error */
}
}
instbuf[i] = '\0';
sendbuf(IDENT_INSTALL,instbuf);
/* Return No Error */
}
MathStart() {
sendbuf(IDENT_START,"");
service_loop();
}
static char *
getcsfield(cpp)
register char **cpp; {
register char *cp,*rcp;
cp = *cpp;
while (*cp == ' ')
cp++;
rcp = cp;
if (*rcp == '\0' || *cp == ',')
return(NULL);
while (*cp != ',' && *cp != '\0')
cp++;
while (*(cp-1) == ' ')
cp--;
if (*cp != '\0')
*cp++ = '\0';
while (*cp == ',' || *cp == ' ')
cp++;
*cpp = cp;
return(rcp);
}
static
typelookup(cp)
register char *cp; {
register int i;
for (i=0;typetab[i] != NULL;i++)
if (strcmp(typetab[i],cp) == 0)
return(i);
return(FALSE);
}
static
service_loop() {
register int i;
register int bfsize;
char inbuf[BUFSIZE];
while (TRUE) {
rcvpkt(inbuf);
bfsize = atoi(inbuf);
for (i=1;i<(bfsize + PKTSIZE - 1)/PKTSIZE;i++)
rcvpkt(&inbuf[i * PKTSIZE]);
switch (inbuf[5]) {
case IDENT_CALL:
docall(&inbuf[7]);
break;
case IDENT_KILL:
exit(0);
default:
;
/* Handle Error */
}
}
}
static
rcvpkt(pktp)
register char *pktp; {
if (read(MATHREADPID,pktp,PKTSIZE) != PKTSIZE) {
/* Handle Error */
exit(1);
}
}
static
sendbuf(bftype,pbuf)
char bftype;
char *pbuf; {
register int i;
register int bfsize;
char outbuf[BUFSIZE];
/* buf_date + nl + bfsize + nl + bfident + nl */
bfsize = strlen(pbuf) + 1 + 4 + 1 + 1 + 1;
if (bfsize >= sizeof outbuf) {
/* Handle Error */
exit(1);
}
sprintf(outbuf,"%4d\n%c\n%s\n",bfsize,bftype,pbuf);
for (i=0;i<(bfsize + PKTSIZE - 1)/PKTSIZE;i++)
sendpkt(&outbuf[i * PKTSIZE]);
}
static
sendpkt(pktp)
register char *pktp; {
if (write(MATHWRITEPID,pktp,PKTSIZE) != PKTSIZE) {
/* Handle Error */
exit(1);
}
}
static
docall(bp)
char *bp; {
register struct FTABENT *ftp;
register struct FALIST *fap;
register char *cp;
int argtplate;
char result[128];
int aidx = 0;
struct {char argv[MAXARGSIZE];} ags;
int *t_ip; double *t_dp; char **t_cpp;
int t_i; double t_d; char *t_cp;
static char *getword();
static struct FTABENT *ftablookup();
extern double atof();
cp = getword(&bp);
if ((ftp = ftablookup(cp)) == NULL) {
/* Handle Error */
exit(1);
}
for (fap = ftp->ft_falist,argtplate=0;fap != NULL;fap = fap->fa_nxt) {
argtplate = 10*argtplate + fap->fa_atype;
switch (fap->fa_atype) {
case T_INT:
t_ip = (int *)&(ags.argv[aidx]);
aidx += sizeof (*t_ip);
*t_ip = atoi(getword(&bp));
break;
case T_DOUBLE:
t_dp = (double *)&(ags.argv[aidx]);
aidx += sizeof (*t_dp);
*t_dp = atof(getword(&bp));
break;
case T_CHARSTAR:
t_cpp = (char **)&(ags.argv[aidx]);
aidx += sizeof (*t_cpp);
*t_cpp = getword(&bp);
break;
}
}
switch (ftp->ft_ftype) {
case T_INT:
switch (argtplate) {
case T_INT:
t_i = (* (int (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0])))
);
break;
case T_DOUBLE:
t_i = (* (int (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0])))
);
break;
case T_CHARSTAR:
t_i = (* (int (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0])))
);
break;
case 10*T_INT+T_INT:
t_i = (* (int (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[4])))
);
break;
case 10*T_INT+T_DOUBLE:
t_i = (* (int (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[4])))
);
break;
case 10*T_INT+T_CHARSTAR:
t_i = (* (int (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[4])))
);
break;
case 10*T_DOUBLE+T_INT:
t_i = (* (int (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[8])))
);
break;
case 10*T_DOUBLE+T_DOUBLE:
t_i = (* (int (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[8])))
);
break;
case 10*T_DOUBLE+T_CHARSTAR:
t_i = (* (int (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[8])))
);
break;
case 10*T_CHARSTAR+T_INT:
t_i = (* (int (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[4])))
);
break;
case 10*T_CHARSTAR+T_DOUBLE:
t_i = (* (int (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[4])))
);
break;
case 10*T_CHARSTAR+T_CHARSTAR:
t_i = (* (int (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[4])))
);
break;
}
sprintf(result,"%d\n",t_i);
break;
case T_DOUBLE:
switch (argtplate) {
case T_INT:
t_d = (* (double (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0])))
);
break;
case T_DOUBLE:
t_d = (* (double (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0])))
);
break;
case T_CHARSTAR:
t_d = (* (double (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0])))
);
break;
case 10*T_INT+T_INT:
t_d = (* (double (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[4])))
);
break;
case 10*T_INT+T_DOUBLE:
t_d = (* (double (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[4])))
);
break;
case 10*T_INT+T_CHARSTAR:
t_d = (* (double (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[4])))
);
break;
case 10*T_DOUBLE+T_INT:
t_d = (* (double (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[8])))
);
break;
case 10*T_DOUBLE+T_DOUBLE:
t_d = (* (double (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[8])))
);
break;
case 10*T_DOUBLE+T_CHARSTAR:
t_d = (* (double (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[8])))
);
break;
case 10*T_CHARSTAR+T_INT:
t_d = (* (double (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[4])))
);
break;
case 10*T_CHARSTAR+T_DOUBLE:
t_d = (* (double (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[4])))
);
break;
case 10*T_CHARSTAR+T_CHARSTAR:
t_d = (* (double (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[4])))
);
break;
}
sprintf(result,"%f\n",t_d);
break;
case T_CHARSTAR:
switch (argtplate) {
case T_INT:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0])))
);
break;
case T_DOUBLE:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0])))
);
break;
case T_CHARSTAR:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0])))
);
break;
case 10*T_INT+T_INT:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[4])))
);
break;
case 10*T_INT+T_DOUBLE:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[4])))
);
break;
case 10*T_INT+T_CHARSTAR:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(int *)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[4])))
);
break;
case 10*T_DOUBLE+T_INT:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[8])))
);
break;
case 10*T_DOUBLE+T_DOUBLE:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[8])))
);
break;
case 10*T_DOUBLE+T_CHARSTAR:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(double *)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[8])))
);
break;
case 10*T_CHARSTAR+T_INT:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(int *)(&(ags.argv[4])))
);
break;
case 10*T_CHARSTAR+T_DOUBLE:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(double *)(&(ags.argv[4])))
);
break;
case 10*T_CHARSTAR+T_CHARSTAR:
t_cp = (* (char * (*)())ftp->ft_func)(
(*(char **)(&(ags.argv[0]))),
(*(char **)(&(ags.argv[4])))
);
break;
}
sprintf(result,"%s\n",t_cp);
break;
}
sendbuf(IDENT_RESULT,result);
}
static
putinbuf(bp,buf,cp)
register int *bp;
register char *buf,*cp; {
register int i;
if (*bp + (i = strlen(cp)) >= BUFSIZE) {
/* Handle Error */
exit(1);
}
strcpy(&buf[*bp],cp);
*bp += i;
}
static
outtypename(bp,buf,type,name)
register int *bp;
register char *buf;
register char *type;
register char *name; {
putinbuf(bp,buf,type);
putinbuf(bp,buf,"\n");
putinbuf(bp,buf,name);
putinbuf(bp,buf,"\n");
}
static char *
getword(cp)
register char **cp; {
register char *sp,*cp1;
sp = cp1 = *cp;
for (;*cp1 != '\0' && *cp1 != '\n';cp1++);
if (cp1 != '\0')
*cp1++ = '\0';
*cp = cp1;
return(sp);
}
static struct FTABENT *
ftablookup(cp)
register char *cp; {
register struct FTABENT *ftp;
for (ftp=ftabbase;ftp != NULL;ftp = ftp->ft_nxt)
if (strcmp(cp,ftp->ft_name) == 0)
return(ftp);
return(NULL);
}
QA360
Valid for 1.0
Not checked yet for 2.0