Jspice3
evaluate.c
Go to the documentation of this file.
1 /***************************************************************************
2 JSPICE3 adaptation of Spice3e2 - Copyright (c) Stephen R. Whiteley 1992
3 Copyright 1990 Regents of the University of California. All rights reserved.
4 Authors: 1985 Wayne A. Christopher
5  1992 Stephen R. Whiteley
6 ****************************************************************************/
7 
8 /*
9  * Convert a parse tree to a list of data vectors.
10  */
11 
12 #include "spice.h"
13 #include "ftedefs.h"
14 #include "ftecmath.h"
15 #ifdef HAVE_SIGNAL
16 #ifdef HAVE_SETJMP
17 #define HAVE_SIGS_AND_LJMP
18 #include <setjmp.h>
19 #include <signal.h>
20 #endif
21 #endif
22 
23 #ifdef __STDC__
24 static RETSIGTYPE sig_matherr(void);
25 static struct dvec *apply_func(struct func*,struct pnode*);
26 static struct dvec *evfunc(struct dvec*,struct func*);
27 static char *mkcname(int,char*,char*);
28 static struct dvec *doop(int,char*(*)(),struct pnode*,struct pnode*);
29 static void fixdims(struct dvec*,struct dvec*,struct dvec*);
30 #else
31 static RETSIGTYPE sig_matherr();
32 static struct dvec *apply_func();
33 static struct dvec *evfunc();
34 static char *mkcname();
35 static struct dvec *doop();
36 static void fixdims();
37 #endif
38 
39 #ifdef HAVE_SIGS_AND_LJMP
40 
41 /* We are careful here to catch SIGILL and recognise them as math errors.
42  * The only trouble is that the signal handler we installed before will
43  * be lost, but that's no great loss.
44  */
45 
46 static jmp_buf matherrbuf;
47 
48 static RETSIGTYPE
49 sig_matherr()
50 {
51  fprintf(cp_err, "Error: argument out of range for math function\n");
52  longjmp(matherrbuf, 1);
53  /* NOTREACHED */
54 }
55 
56 #endif
57 
58 
59 /* Note that ft_evaluate will return NULL on invalid expressions. */
60 
61 struct dvec *
63 
64 struct pnode *node;
65 {
66  struct dvec *d;
67 
68  if (!node)
69  return (NULL);
70  else if (node->pn_value)
71  d = node->pn_value;
72  else if (node->pn_func)
73  d = apply_func(node->pn_func, node->pn_left);
74  else if (node->pn_op) {
75  if (node->pn_op->op_arity == 1)
76  d = (struct dvec *)
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));
81  }
82  else {
83  fprintf(cp_err, "ft_evaluate: Internal Error: bad node\n");
84  return (NULL);
85  }
86 
87  if (!d) {
88  return NULL;
89  }
90 
91  if (node->pn_name && !ft_evdb) {
92  txfree(d->v_name);
93  d->v_name = copy(node->pn_name);
94  }
95 
96  if (!d->v_length && !d->v_link2) {
97  fprintf(cp_err, "Error: no such vector %s\n", d->v_name);
98  return (NULL);
99  }
100  return (d);
101 }
102 
103 
104 struct dvlist *
106 
107 /* create a dveclist, free the pn */
108 struct pnode *p0;
109 {
110  struct dvlist *dl0 = NULL, *dl, *dll;
111  struct dvec *v;
112  struct pnode *pn;
113 
114  for (pn = p0; pn; pn = pn->pn_next) {
115  if ((v = ft_evaluate(pn)) == NULL) {
116  vec_dlfree(dl0);
117  inp_pnfree(p0);
118  return (NULL);
119  }
120  if (!dl0)
121  dl0 = dl = alloc(struct dvlist);
122  else {
123  dl->dl_next = alloc(struct dvlist);
124  dl = dl->dl_next;
125  }
126  if (v->v_link2) {
127  for (dll = v->v_link2; dll; dll = dll->dl_next) {
128  dl->dl_dvec = dll->dl_dvec;
129  if (dll->dl_next) {
130  dl->dl_next = alloc(struct dvlist);
131  dl = dl->dl_next;
132  }
133  }
134  }
135  else
136  dl->dl_dvec = v;
137  }
138  inp_pnfree(p0);
139  return (dl0);
140 }
141 
142 
143 /* The binary operations. */
144 
145 struct dvec *
146 op_plus(arg1, arg2)
147  struct pnode *arg1, *arg2;
148 {
149  return (doop('+', cx_plus, arg1, arg2));
150 }
151 
152 
153 struct dvec *
154 op_minus(arg1, arg2)
155 
156 struct pnode *arg1, *arg2;
157 {
158  return (doop('-', cx_minus, arg1, arg2));
159 }
160 
161 
162 struct dvec *
163 op_comma(arg1, arg2)
164 
165 struct pnode *arg1, *arg2;
166 {
167  return (doop(',', cx_comma, arg1, arg2));
168 }
169 
170 
171 struct dvec *
172 op_times(arg1, arg2)
173 
174 struct pnode *arg1, *arg2;
175 {
176  return (doop('*', cx_times, arg1, arg2));
177 }
178 
179 
180 struct dvec *
181 op_mod(arg1, arg2)
182 
183 struct pnode *arg1, *arg2;
184 {
185  return (doop('%', cx_mod, arg1, arg2));
186 }
187 
188 
189 struct dvec *
190 op_divide(arg1, arg2)
191 
192 struct pnode *arg1, *arg2;
193 {
194  return (doop('/', cx_divide, arg1, arg2));
195 }
196 
197 
198 struct dvec *
199 op_power(arg1, arg2)
200 
201 struct pnode *arg1, *arg2;
202 {
203  return (doop('^', cx_power, arg1, arg2));
204 }
205 
206 
207 struct dvec *
208 op_eq(arg1, arg2)
209 
210 struct pnode *arg1, *arg2;
211 {
212  return (doop('=', cx_eq, arg1, arg2));
213 }
214 
215 
216 struct dvec *
217 op_gt(arg1, arg2)
218 
219 struct pnode *arg1, *arg2;
220 {
221  return (doop('>', cx_gt, arg1, arg2));
222 }
223 
224 
225 struct dvec *
226 op_lt(arg1, arg2)
227 
228 struct pnode *arg1, *arg2;
229 {
230  return (doop('<', cx_lt, arg1, arg2));
231 }
232 
233 
234 struct dvec *
235 op_ge(arg1, arg2)
236 
237 struct pnode *arg1, *arg2;
238 {
239  return (doop('G', cx_ge, arg1, arg2));
240 }
241 
242 
243 struct dvec *
244 op_le(arg1, arg2)
245 
246 struct pnode *arg1, *arg2;
247 {
248  return (doop('L', cx_le, arg1, arg2));
249 }
250 
251 
252 struct dvec *
253 op_ne(arg1, arg2)
254 
255 struct pnode *arg1, *arg2;
256 {
257  return (doop('N', cx_ne, arg1, arg2));
258 }
259 
260 
261 struct dvec *
262 op_and(arg1, arg2)
263 
264 struct pnode *arg1, *arg2;
265 {
266  return (doop('&', cx_and, arg1, arg2));
267 }
268 
269 
270 struct dvec *
271 op_or(arg1, arg2)
272 
273 struct pnode *arg1, *arg2;
274 {
275  return (doop('|', cx_or, arg1, arg2));
276 }
277 
278 
279 /* This is an odd operation. The first argument is the name of a vector, and
280  * the second is a range in the scale, so that v(1)[[10, 20]] gives all the
281  * values of v(1) for which the TIME value is between 10 and 20. If there is
282  * one argument it picks out the values which have that scale value.
283  * NOTE that we totally ignore multi-dimensionality here -- the result is
284  * a 1-dim vector.
285  */
286 
287 struct dvec *
288 op_range(arg1, arg2)
289 
290 struct pnode *arg1, *arg2;
291 {
292  struct dvec *v, *ind, *res, *scale; /* , *nscale; */
293  double up, low, td;
294  int len, i, j;
295  bool rev = false;
296 
297  v = ft_evaluate(arg1);
298  ind = ft_evaluate(arg2);
299  if (!v || !ind)
300  return (NULL);
301  scale = v->v_scale;
302  if (!scale)
303  scale = v->v_plot->pl_scale;
304  if (!scale) {
305  fprintf(cp_err, "Error: no scale for vector %s\n", v->v_name);
306  return (NULL);
307  }
308 
309  if (ind->v_length != 1) {
310  fprintf(cp_err, "Error: strange range specification\n");
311  return (NULL);
312  }
313  if (isreal(ind)) {
314  up = low = *ind->v_realdata;
315  } else {
316  up = imagpart(ind->v_compdata);
317  low = realpart(ind->v_compdata);
318  }
319  if (up < low) {
320  td = up;
321  up = low;
322  low = td;
323  rev = true;
324  }
325  for (i = len = 0; i < scale->v_length; i++) {
326  td = isreal(scale) ? scale->v_realdata[i] :
327  realpart(&scale->v_compdata[i]);
328  if ((td <= up) && (td >= low))
329  len++;
330  }
331 
332  res = alloc(struct dvec);
333  res->v_flags = v->v_flags;
334  res->v_name = mkcname('R', v->v_name, ind->v_name);
335  res->v_defcolor = v->v_defcolor;
336  res->v_gridtype = v->v_gridtype;
337  res->v_plottype = v->v_plottype;
338  res->v_type = v->v_type;
339  res->v_length = len;
340  res->v_scale = /* nscale; */ scale;
341  res->v_numdims = v->v_numdims;
342  for (i = 0; i < v->v_numdims; i++)
343  res->v_dims[i] = v->v_dims[i];
344 
345  if (isreal(res))
346  res->v_realdata = (double *) tmalloc(sizeof (double) * len);
347  else
348  res->v_compdata = (complex *) tmalloc(sizeof (complex) * len);
349 
350  /* Toss in the data */
351 
352  j = 0;
353  for (i = (rev ? v->v_length - 1 : 0); i != (rev ? -1 : v->v_length);
354  rev ? i-- : i++) {
355  td = isreal(scale) ? scale->v_realdata[i] :
356  realpart(&scale->v_compdata[i]);
357  if ((td <= up) && (td >= low)) {
358  if (isreal(res)) {
359  res->v_realdata[j] = v->v_realdata[i];
360  }
361  else {
362  realpart(&res->v_compdata[j]) =
363  realpart(&v->v_compdata[i]);
364  imagpart(&res->v_compdata[j]) =
365  imagpart(&v->v_compdata[i]);
366  }
367  j++;
368  }
369  }
370  if (j != len)
371  fprintf(cp_err, "Error: something funny..\n");
372 
373  vec_newtemp(res);
374  return (res);
375 }
376 
377 
378 /* This is another operation we do specially -- if the argument is a vector of
379  * dimension n, n > 0, the result will be either a vector of dimension n - 1,
380  * or a vector of dimension n with only a certain range of vectors present.
381  */
382 
383 struct dvec *
384 op_ind(arg1, arg2)
385 
386 struct pnode *arg1, *arg2;
387 {
388  struct dvec *v, *ind, *res;
389  int length, i, j, k, up, down;
390  int majsize, blocksize;
391  bool rev = false, newdim;
392 
393  v = ft_evaluate(arg1);
394  ind = ft_evaluate(arg2);
395  if (!v || !ind)
396  return (NULL);
397 
398  /* First let's check to make sure that the vector is consistent */
399  if (v->v_numdims > 1) {
400  for (i = 0, j = 1; i < v->v_numdims; i++)
401  j *= v->v_dims[i];
402  if (v->v_length != j) {
403  fprintf(cp_err,
404  "op_ind: Internal Error: len %d should be %d\n",
405  v->v_length, j);
406  return (NULL);
407  }
408  }
409  else {
410  /* Just in case we were sloppy */
411  v->v_numdims = 1;
412  v->v_dims[0] = v->v_length;
413  if (v->v_length <= 1) {
414  fprintf(cp_err, "Error: no indexing on a scalar (%s)\n",
415  v->v_name);
416  return (NULL);
417  }
418  }
419 
420  if (ind->v_length != 1) {
421  fprintf(cp_err, "Error: index %s is not of length 1\n",
422  ind->v_name);
423  return (NULL);
424  }
425 
426  majsize = v->v_dims[0];
427  blocksize = v->v_length/majsize;
428 
429  /* Now figure out if we should put the dim down by one. Because of the
430  * way we parse the index, we figure that if the value is complex
431  * (e.g, "[1,2]"), the guy meant a range. This is sort of bad though.
432  */
433  if (isreal(ind)) {
434  newdim = true;
435  down = up = ind->v_realdata[0];
436  length = blocksize;
437  }
438  else {
439  newdim = false;
440  down = realpart(&ind->v_compdata[0]);
441  up = imagpart(&ind->v_compdata[0]);
442 
443  if (up < down) {
444  i = up;
445  up = down;
446  down = i;
447  rev = true;
448  }
449  if (up < 0) {
450  fprintf(cp_err, "Warning: upper limit %d should be 0\n", up);
451  up = 0;
452  }
453  if (up >= majsize) {
454  fprintf(cp_err, "Warning: upper limit %d should be %d\n", up,
455  majsize - 1);
456  up = majsize - 1;
457  }
458  if (down < 0) {
459  fprintf(cp_err, "Warning: lower limit %d should be 0\n", down);
460  down = 0;
461  }
462  if (down >= majsize) {
463  fprintf(cp_err, "Warning: lower limit %d should be %d\n", down,
464  majsize - 1);
465  down = majsize - 1;
466  }
467  length = blocksize * (up - down + 1);
468  }
469 
470  /* Make up the new vector. */
471  res = alloc(struct dvec);
472  res->v_flags = v->v_flags;
473  res->v_name = mkcname('[', v->v_name, ind->v_name);
474  res->v_defcolor = v->v_defcolor;
475  res->v_gridtype = v->v_gridtype;
476  res->v_plottype = v->v_plottype;
477  res->v_type = v->v_type;
478  res->v_length = length;
479  if (newdim) {
480  res->v_numdims = v->v_numdims - 1;
481  for (i = 0; i < res->v_numdims; i++)
482  res->v_dims[i] = v->v_dims[i + 1];
483  }
484  else {
485  res->v_numdims = v->v_numdims;
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];
489  }
490 
491  /* And toss in the new data */
492 
493  if (isreal(res)) {
494  double *src, *dst;
495 
496  res->v_realdata = (double *) tmalloc(sizeof(double) * length);
497  src = v->v_realdata + up*blocksize;
498  dst = res->v_realdata + (rev ? 0 : up - down)*blocksize;
499  for (j = up - down; j >= 0; j--) {
500  DCOPY(src,dst,blocksize);
501  src -= blocksize;
502  dst += (rev ? blocksize : -blocksize);
503  }
504  }
505  else {
506  complex *src, *dst;
507 
508  res->v_compdata = (complex *) tmalloc(sizeof(complex) * length);
509  src = v->v_compdata + up*blocksize;
510  dst = res->v_compdata + (rev ? 0 : up - down)*blocksize;
511  for (j = up - down; j >= 0; j--) {
512  CCOPY(src,dst,blocksize);
513  src -= blocksize;
514  dst += (rev ? blocksize : -blocksize);
515  }
516  }
517 
518  /* This is a problem -- the old scale will be no good. I guess we
519  * should make an altered copy of the old scale also.
520  */
521  res->v_scale = NULL;
522 
523  vec_newtemp(res);
524  return (res);
525 }
526 
527 
528 /* Apply a function to an argument. Complex functions are called as follows:
529  * cx_something(data, type, length, &newlength, &newtype),
530  * and returns a char * that is cast to complex or double.
531  */
532 
533 static struct dvec *
535 
536 struct func *func;
537 struct pnode *arg;
538 {
539  struct dvec *v, *t, *newv;
540  struct dvlist *dl, *tl, *tl0;
541  char buf[BSIZE_SP];
542 
543  /* Special case. This is not good -- happens when vm(), etc are used
544  * and it gets caught as a user-definable function. Usually v()
545  * is caught in the parser.
546  */
547  if (!func->fu_func) {
548  if (!arg->pn_value || (arg->pn_value->v_length != 1)) {
549  fprintf(cp_err, "Error: bad v() syntax\n");
550  return (NULL);
551  }
552  (void) sprintf(buf, "v(%s)", arg->pn_value->v_name);
553  t = vec_fromplot(buf, plot_cur);
554  if (!t) {
555  fprintf(cp_err, "Error: no such vector %s\n", buf);
556  return (NULL);
557  }
558  t = vec_copy(t);
559  vec_newtemp(t);
560  return (t);
561  }
562  v = ft_evaluate(arg);
563  if (v == NULL)
564  return (NULL);
565 
566  if (v->v_link2) {
567  tl0 = NULL;
568  for (dl = v->v_link2; dl; dl = dl->dl_next) {
569  v = evfunc(dl->dl_dvec,func);
570  if (v) {
571  if (!tl0)
572  tl0 = tl = alloc(struct dvlist);
573  else {
574  tl->dl_next = alloc(struct dvlist);
575  tl = tl->dl_next;
576  }
577  tl->dl_dvec = v;
578  }
579  }
580  if (tl0) {
581  newv = alloc(struct dvec);
582  vec_newtemp(newv);
583  newv->v_link2 = tl0;
584  newv->v_name = copy("list");
585  return (newv);
586  }
587  else
588  return (NULL);
589  }
590  return (evfunc(v,func));
591 }
592 
593 
594 static struct dvec *
596 
597 struct dvec *v;
598 struct func *func;
599 {
600  struct dvec *t;
601  char *data;
602  int len, i;
603  short type;
604 
605 #ifdef HAVE_SIGS_AND_LJMP
606  /* Some of the math routines generate SIGILL if the argument is
607  * out of range. Catch this here.
608  */
609  if (setjmp(matherrbuf)) {
610  (void) signal(SIGILL, SIG_DFL);
611  return (NULL);
612  }
613  (void) signal(SIGILL, (RETSIGTYPE(*)())sig_matherr);
614 #endif
615 
616  if (eq(func->fu_name, "interpolate")
617  || eq(func->fu_name, "deriv")) /* Ack */
618  data = (char *) ((*func->fu_func) ((isreal(v) ? (char *)
619  v->v_realdata : (char *) v->v_compdata),
620  (short) (isreal(v) ? VF_REAL : VF_COMPLEX),
621  v->v_length, &len, &type, v->v_plot,
622  plot_cur));
623  else
624  data = (char *) ((*func->fu_func) ((isreal(v) ? (char *)
625  v->v_realdata : (char *) v->v_compdata),
626  (short) (isreal(v) ? VF_REAL : VF_COMPLEX),
627  v->v_length, &len, &type));
628 #ifdef HAVE_SIGS_AND_LJMP
629  /* Back to normal */
630  (void) signal(SIGILL, SIG_DFL);
631 #endif
632 
633  if (!data)
634  return (NULL);
635 
636  t = alloc(struct dvec);
637  vec_newtemp(t);
638 
639  t->v_flags = (v->v_flags & ~VF_COMPLEX & ~VF_REAL &
641  t->v_flags |= type;
642 #ifdef FTEDEBUG
643  if (ft_evdb)
644  fprintf(cp_err,
645  "apply_func: func %s to %s len %d, type %d\n",
646  func->fu_name, v->v_name, len, type);
647 #endif
648  if (isreal(t))
649  t->v_realdata = (double *) data;
650  else
651  t->v_compdata = (complex *) data;
652  if (eq(func->fu_name, "minus"))
653  t->v_name = mkcname('a', func->fu_name, v->v_name);
654  else if (eq(func->fu_name, "not"))
655  t->v_name = mkcname('c', func->fu_name, v->v_name);
656  else
657  t->v_name = mkcname('b', v->v_name, (char *) NULL);
658  t->v_type = v->v_type; /* This is strange too. */
659  t->v_length = len;
660  t->v_scale = v->v_scale;
661 
662  /* Copy a few useful things */
663  t->v_defcolor = v->v_defcolor;
664  t->v_gridtype = v->v_gridtype;
665  t->v_plottype = v->v_plottype;
666  t->v_numdims = v->v_numdims;
667  for (i = 0; i < t->v_numdims; i++)
668  t->v_dims[i] = v->v_dims[i];
669 
670  return (t);
671 }
672 
673 
674 /* The unary minus operation. */
675 
676 struct dvec *
678 
679 struct pnode *arg;
680 {
681  return (apply_func(&func_uminus, arg));
682 }
683 
684 
685 struct dvec *
686 op_not(arg)
687 
688 struct pnode *arg;
689 {
690  return (apply_func(&func_not, arg));
691 }
692 
693 
694 /* Create a reasonable name for the result of a function application, etc.
695  * The what values 'a' and 'b' mean "make a function name" and "make a
696  * unary minus", respectively.
697  */
698 
699 static char *
700 mkcname(what, v1, v2)
701 
702 char what;
703 char *v1, *v2;
704 {
705  char buf[BSIZE_SP], *s;
706 
707  if (what == 'a')
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);
717  else
718  (void) sprintf(buf, "(%s)%c(%s)", v1, what, v2);
719  s = copy(buf);
720  return (s);
721 }
722 
723 
724 /* Operate on two vectors, and return a third with the data, length, and flags
725  * fields filled in. Add it to the current plot and get rid of the two args.
726  */
727 
728 static struct dvec *
729 doop(what, func, arg1, arg2)
730 
731 char what;
732 char *(*func)();
733 struct pnode *arg1, *arg2;
734 {
735  struct dvec *v1, *v2, *res;
736  complex *c1, *c2, lc;
737  double *d1, *d2, ld;
738  int length, i;
739  char *data;
740  bool free1 = false, free2 = false, relflag = false;
741 
742  v1 = ft_evaluate(arg1);
743  v2 = ft_evaluate(arg2);
744  if (!v1 || !v2)
745  return (NULL);
746 
747  /* Now the question is, what do we do when one or both of these
748  * has more than one vector? This is definitely not a good
749  * thing. For the time being don't do anything.
750  */
751  if (v1->v_link2 || v2->v_link2) {
752  fprintf(cp_err, "Warning: no operations on wildcards yet.\n");
753  if (v1->v_link2 && v2->v_link2)
754  fprintf(cp_err, "\t(You couldn't do that one anyway)\n");
755  return (NULL);
756  }
757 
758  /* This is a bad way to do this. */
759  switch (what) {
760  case '=':
761  case '>':
762  case '<':
763  case 'G':
764  case 'L':
765  case 'N':
766  case '&':
767  case '|':
768  case '~':
769  relflag = true;
770  }
771 
772  /* Don't bother to do type checking. Maybe this should go in at
773  * some point.
774  */
775 
776  /* Make sure we have data of the same length. */
777  length = ((v1->v_length > v2->v_length) ? v1->v_length : v2->v_length);
778  if (v1->v_length < length) {
779  free1 = true;
780  if (isreal(v1)) {
781  ld = 0.0;
782  d1 = (double *) tmalloc(length * sizeof (double));
783  for (i = 0; i < v1->v_length; i++)
784  d1[i] = v1->v_realdata[i];
785  if (length > 0)
786  ld = v1->v_realdata[v1->v_length - 1];
787  for ( ; i < length; i++)
788  d1[i] = ld;
789  }
790  else {
791  realpart(&lc) = 0.0;
792  imagpart(&lc) = 0.0;
793  c1 = (complex *) tmalloc(length * sizeof (complex));
794  for (i = 0; i < v1->v_length; i++)
795  c1[i] = v1->v_compdata[i];
796  if (length > 0)
797  lc = v1->v_compdata[v1->v_length - 1];
798  for ( ; i < length; i++)
799  c1[i] = lc;
800  }
801  }
802  else {
803  if (isreal(v1))
804  d1 = v1->v_realdata;
805  else
806  c1 = v1->v_compdata;
807  }
808  if (v2->v_length < length) {
809  free2 = true;
810  if (isreal(v2)) {
811  ld = 0.0;
812  d2 = (double *) tmalloc(length * sizeof (double));
813  for (i = 0; i < v2->v_length; i++)
814  d2[i] = v2->v_realdata[i];
815  if (length > 0)
816  ld = v2->v_realdata[v2->v_length - 1];
817  for ( ; i < length; i++)
818  d2[i] = ld;
819  }
820  else {
821  realpart(&lc) = 0.0;
822  imagpart(&lc) = 0.0;
823  c2 = (complex *) tmalloc(length * sizeof (complex));
824  for (i = 0; i < v2->v_length; i++)
825  c2[i] = v2->v_compdata[i];
826  if (length > 0)
827  lc = v2->v_compdata[v1->v_length - 1];
828  for ( ; i < length; i++)
829  c2[i] = lc;
830  }
831  }
832  else {
833  if (isreal(v2))
834  d2 = v2->v_realdata;
835  else
836  c2 = v2->v_compdata;
837  }
838 
839 #ifdef HAVE_SIGS_AND_LJMP
840  /* Some of the math routines generate SIGILL if the argument is
841  * out of range. Catch this here.
842  */
843  if (setjmp(matherrbuf)) {
844  return (NULL);
845  }
846  (void) signal(SIGILL, (RETSIGTYPE(*)())sig_matherr);
847 #endif
848 
849  /* Now pass the vectors to the appropriate function. */
850  data = (char *) ((*func) ((isreal(v1) ? (char *) d1 : (char *) c1),
851  (isreal(v2) ? (char *) d2 : (char *) c2),
852  (isreal(v1) ? VF_REAL : VF_COMPLEX),
853  (isreal(v2) ? VF_REAL : VF_COMPLEX),
854  length));
855 #ifdef HAVE_SIGS_AND_LJMP
856  /* Back to normal */
857  (void) signal(SIGILL, SIG_DFL);
858 #endif
859 
860  if (!data) return NULL;
861 
862  /* Make up the new vector. */
863  res = alloc(struct dvec);
864 
865  if (relflag || (isreal(v1) && isreal(v2) && (cx_comma != func))) {
866 
867  res->v_flags = (v1->v_flags | v2->v_flags |
868  VF_REAL) & ~ VF_COMPLEX;
869  res->v_realdata = (double *) data;
870  }
871  else {
872  res->v_flags = (v1->v_flags | v2->v_flags |
873  VF_COMPLEX) & ~ VF_REAL;
874  res->v_compdata = (complex *) data;
875  }
876 
877  res->v_name = mkcname(what, v1->v_name, v2->v_name);
878  res->v_length = length;
879 
880  fixdims(res,v1,v2);
881 
882  /* Copy a few useful things */
883  res->v_defcolor = v1->v_defcolor;
884  res->v_gridtype = v1->v_gridtype;
885  res->v_plottype = v1->v_plottype;
886 
887  vec_newtemp(res);
888 
889  /* Free the temporary data areas we used, if we allocated any. */
890  if (free1) {
891  if (isreal(v1))
892  txfree((char*)d1);
893  else
894  txfree((char*)c1);
895  }
896  if (free2) {
897  if (isreal(v2))
898  txfree((char*)d2);
899  else
900  txfree((char*)c2);
901  }
902 
903  return (res);
904 }
905 
906 
907 static void
908 fixdims(r,v1,v2)
909 
910 /* Give the result the maximum dimensionality of the two vectors.
911  * This also arbitrates the scale and type of the resultant.
912  */
913 struct dvec *r, *v1, *v2;
914 {
915  int i;
916 
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;
923  }
924  else {
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;
930  }
931 }
struct dvec * op_and(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:262
struct dvec * op_not(struct pnode *arg)
Definition: evaluate.c:686
struct dvec * op_comma(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:163
static char buf[MAXPROMPT]
Definition: arg.c:18
#define BSIZE_SP
Definition: misc.h:19
#define eq(a, b)
Definition: misc.h:29
struct dvec * op_le(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:244
struct dvec * op_lt(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:226
static RETSIGTYPE sig_matherr()
struct dvec * op_power(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:199
#define VF_REAL
Definition: fteconst.h:39
static void fixdims()
struct dvlist * v_link2
Definition: ftedata.h:44
void vec_newtemp()
Definition: cddefs.h:119
struct plot * plot_cur
Definition: vectors.c:43
if(TDesc==NULL)
Definition: cd.c:1326
Definition: ftedata.h:49
struct dvec * op_plus(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:146
Definition: cpstd.h:29
char * cx_plus()
struct dvec * op_minus(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:154
struct dvec * op_uminus(struct pnode *arg)
Definition: evaluate.c:677
struct dvec * op_gt(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:217
struct dvec * op_eq(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:208
struct dvec * op_times(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:172
static struct dvec * doop()
char * cx_minus()
int v_dims[MAXDIMS]
Definition: ftedata.h:41
char * fu_name
Definition: fteparse.h:38
struct dvec * op_ge(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:235
char * cx_le()
struct dvec * op_range(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:288
#define alloc(type)
Definition: cdmacs.h:21
complex * v_compdata
Definition: ftedata.h:29
#define DCOPY(s, d, n)
Definition: ftedefs.h:55
#define CCOPY(s, d, n)
Definition: ftedefs.h:59
char * copy()
char * cx_or()
struct dvlist * dl_next
Definition: ftedata.h:51
void inp_pnfree()
FILE * cp_err
Definition: help.c:101
char * tmalloc()
static struct dvec * apply_func()
char * cx_and()
Definition: cddefs.h:237
void txfree()
struct dvec * pl_scale
Definition: ftedata.h:68
#define NULL
Definition: spdefs.h:121
Definition: types.c:18
struct dvlist * ft_dvlist(struct pnode *p0)
Definition: evaluate.c:105
GRIDTYPE v_gridtype
Definition: ftedata.h:32
struct plot * v_plot
Definition: ftedata.h:42
char * v_defcolor
Definition: ftedata.h:39
struct dvec * v_scale
Definition: ftedata.h:45
struct dvec * vec_fromplot()
struct pnode * pn_next
Definition: fteparse.h:23
struct dvec * ft_evaluate(struct pnode *node)
Definition: evaluate.c:62
#define isreal(v)
Definition: ftedata.h:54
Definition: ftedata.h:24
struct dvec * dl_dvec
Definition: ftedata.h:50
char * cx_times()
char * v_name
Definition: ftedata.h:25
#define imagpart(cval)
Definition: cpstd.h:36
struct func func_not
Definition: parse.c:697
char * cx_power()
char * cx_lt()
#define VF_MAXGIVEN
Definition: fteconst.h:45
Definition: fteparse.h:37
char * cx_gt()
void vec_dlfree()
bool ft_evdb
Definition: options.c:27
return(True)
struct dvec * op_or(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:271
int v_type
Definition: ftedata.h:26
struct dvec * pn_value
Definition: fteparse.h:18
char * cx_eq()
static struct dvec * evfunc()
struct dvec * op_divide(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:190
struct dvec * op_ne(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:253
Definition: cddefs.h:162
char * cx_mod()
int v_numdims
Definition: ftedata.h:40
PLOTTYPE v_plottype
Definition: ftedata.h:33
int v_length
Definition: ftedata.h:34
short v_flags
Definition: ftedata.h:27
double * v_realdata
Definition: ftedata.h:28
char * cx_comma()
char * cx_ge()
struct func func_uminus
Definition: parse.c:695
struct dvec * op_ind(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:384
Definition: cddefs.h:192
#define VF_COMPLEX
Definition: fteconst.h:40
char *(* fu_func)()
Definition: fteparse.h:39
struct dvec * op_mod(struct pnode *arg1, struct pnode *arg2)
Definition: evaluate.c:181
static char * mkcname()
char * cx_divide()
struct dvec * vec_copy()
#define VF_MINGIVEN
Definition: fteconst.h:44
#define realpart(cval)
Definition: cpstd.h:35
Definition: fteparse.h:16
char * cx_ne()