17 #define HAVE_SIGS_AND_LJMP 27 static char *
mkcname(
int,
char*,
char*);
39 #ifdef HAVE_SIGS_AND_LJMP 46 static jmp_buf matherrbuf;
51 fprintf(
cp_err,
"Error: argument out of range for math function\n");
52 longjmp(matherrbuf, 1);
70 else if (node->pn_value)
72 else if (node->pn_func)
74 else if (node->pn_op) {
75 if (node->pn_op->op_arity == 1)
77 ((*node->pn_op->op_func) (node->pn_left));
78 else if (node->pn_op->op_arity == 2)
79 d = (
struct dvec *) ((*node->pn_op->op_func)
80 (node->pn_left, node->pn_right));
83 fprintf(
cp_err,
"ft_evaluate: Internal Error: bad node\n");
91 if (node->pn_name && !
ft_evdb) {
97 fprintf(
cp_err,
"Error: no such vector %s\n", d->
v_name);
114 for (pn = p0; pn; pn = pn->
pn_next) {
128 dl->dl_dvec = dll->dl_dvec;
147 struct
pnode *arg1, *arg2;
156 struct
pnode *arg1, *arg2;
165 struct
pnode *arg1, *arg2;
174 struct
pnode *arg1, *arg2;
183 struct
pnode *arg1, *arg2;
192 struct
pnode *arg1, *arg2;
201 struct
pnode *arg1, *arg2;
210 struct
pnode *arg1, *arg2;
219 struct
pnode *arg1, *arg2;
228 struct
pnode *arg1, *arg2;
237 struct
pnode *arg1, *arg2;
246 struct
pnode *arg1, *arg2;
255 struct
pnode *arg1, *arg2;
264 struct
pnode *arg1, *arg2;
273 struct
pnode *arg1, *arg2;
290 struct
pnode *arg1, *arg2;
292 struct dvec *v, *ind, *res, *scale;
305 fprintf(
cp_err,
"Error: no scale for vector %s\n", v->
v_name);
310 fprintf(
cp_err,
"Error: strange range specification\n");
325 for (i = len = 0; i < scale->
v_length; i++) {
328 if ((td <= up) && (td >= low))
357 if ((td <= up) && (td >= low)) {
371 fprintf(
cp_err,
"Error: something funny..\n");
386 struct
pnode *arg1, *arg2;
388 struct dvec *v, *ind, *res;
389 int length, i, j, k, up, down;
390 int majsize, blocksize;
391 bool rev =
false, newdim;
400 for (i = 0, j = 1; i < v->
v_numdims; i++)
404 "op_ind: Internal Error: len %d should be %d\n",
414 fprintf(
cp_err,
"Error: no indexing on a scalar (%s)\n",
421 fprintf(
cp_err,
"Error: index %s is not of length 1\n",
450 fprintf(
cp_err,
"Warning: upper limit %d should be 0\n", up);
454 fprintf(
cp_err,
"Warning: upper limit %d should be %d\n", up,
459 fprintf(
cp_err,
"Warning: lower limit %d should be 0\n", down);
462 if (down >= majsize) {
463 fprintf(
cp_err,
"Warning: lower limit %d should be %d\n", down,
467 length = blocksize * (up - down + 1);
478 res->v_length = length;
481 for (i = 0; i < res->v_numdims; i++)
482 res->v_dims[i] = v->
v_dims[i + 1];
486 res->v_dims[0] = up - down + 1;
487 for (i = 1; i < res->v_numdims; i++)
488 res->v_dims[i] = v->
v_dims[i];
496 res->v_realdata = (
double *)
tmalloc(
sizeof(
double) * length);
498 dst = res->v_realdata + (rev ? 0 : up - down)*blocksize;
499 for (j = up - down; j >= 0; j--) {
500 DCOPY(src,dst,blocksize);
502 dst += (rev ? blocksize : -blocksize);
510 dst = res->v_compdata + (rev ? 0 : up - down)*blocksize;
511 for (j = up - down; j >= 0; j--) {
512 CCOPY(src,dst,blocksize);
514 dst += (rev ? blocksize : -blocksize);
539 struct dvec *v, *
t, *newv;
540 struct dvlist *dl, *tl, *tl0;
547 if (!func->fu_func) {
549 fprintf(
cp_err,
"Error: bad v() syntax\n");
555 fprintf(
cp_err,
"Error: no such vector %s\n", buf);
605 #ifdef HAVE_SIGS_AND_LJMP 609 if (setjmp(matherrbuf)) {
610 (void) signal(SIGILL, SIG_DFL);
613 (void) signal(SIGILL, (RETSIGTYPE(*)())
sig_matherr);
619 v->v_realdata : (
char *) v->v_compdata),
621 v->v_length, &len, &type, v->v_plot,
625 v->v_realdata : (
char *) v->v_compdata),
627 v->v_length, &len, &type));
628 #ifdef HAVE_SIGS_AND_LJMP 630 (void) signal(SIGILL, SIG_DFL);
645 "apply_func: func %s to %s len %d, type %d\n",
646 func->
fu_name, v->v_name, len, type);
668 t->
v_dims[i] = v->v_dims[i];
708 (void) sprintf(buf,
"%s(%s)", v1, v2);
709 else if (what ==
'b')
710 (void) sprintf(buf,
"-(%s)", v1);
711 else if (what ==
'c')
712 (void) sprintf(buf,
"~(%s)", v1);
713 else if (what ==
'[')
714 (void) sprintf(buf,
"%s[%s]", v1, v2);
715 else if (what ==
'R')
716 (void) sprintf(buf,
"%s[[%s]]", v1, v2);
718 (
void) sprintf(buf,
"(%s)%c(%s)", v1, what, v2);
733 struct
pnode *arg1, *arg2;
735 struct dvec *v1, *v2, *res;
740 bool free1 =
false, free2 =
false, relflag =
false;
752 fprintf(
cp_err,
"Warning: no operations on wildcards yet.\n");
754 fprintf(
cp_err,
"\t(You couldn't do that one anyway)\n");
782 d1 = (
double *)
tmalloc(length *
sizeof (
double));
787 for ( ; i < length; i++)
798 for ( ; i < length; i++)
812 d2 = (
double *)
tmalloc(length *
sizeof (
double));
817 for ( ; i < length; i++)
828 for ( ; i < length; i++)
839 #ifdef HAVE_SIGS_AND_LJMP 843 if (setjmp(matherrbuf)) {
846 (void) signal(SIGILL, (RETSIGTYPE(*)())
sig_matherr);
850 data = (
char *) ((*func) ((
isreal(v1) ? (
char *) d1 : (
char *) c1),
851 (
isreal(v2) ? (
char *) d2 : (
char *) c2),
855 #ifdef HAVE_SIGS_AND_LJMP 857 (void) signal(SIGILL, SIG_DFL);
860 if (!data)
return NULL;
913 struct
dvec *
r, *v1, *v2;
917 if (v1->v_numdims >= v2->v_numdims) {
918 for (i = 0; i < v1->v_numdims; i++)
919 r->v_dims[i] = v1->v_dims[i];
920 r->v_numdims = v1->v_numdims;
921 r->v_scale = v1->v_scale;
922 r->v_type = v1->v_type;
925 for (i = 0; i < v2->v_numdims; i++)
926 r->v_dims[i] = v2->v_dims[i];
927 r->v_numdims = v2->v_numdims;
928 r->v_scale = v2->v_scale;
929 r->v_type = v2->v_type;
struct dvec * op_and(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_not(struct pnode *arg)
struct dvec * op_comma(struct pnode *arg1, struct pnode *arg2)
static char buf[MAXPROMPT]
struct dvec * op_le(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_lt(struct pnode *arg1, struct pnode *arg2)
static RETSIGTYPE sig_matherr()
struct dvec * op_power(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_plus(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_minus(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_uminus(struct pnode *arg)
struct dvec * op_gt(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_eq(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_times(struct pnode *arg1, struct pnode *arg2)
static struct dvec * doop()
struct dvec * op_ge(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_range(struct pnode *arg1, struct pnode *arg2)
static struct dvec * apply_func()
struct dvlist * ft_dvlist(struct pnode *p0)
struct dvec * vec_fromplot()
struct dvec * ft_evaluate(struct pnode *node)
struct dvec * op_or(struct pnode *arg1, struct pnode *arg2)
static struct dvec * evfunc()
struct dvec * op_divide(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_ne(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_ind(struct pnode *arg1, struct pnode *arg2)
struct dvec * op_mod(struct pnode *arg1, struct pnode *arg2)