Jspice3
evaluate.c File Reference
#include "spice.h"
#include "ftedefs.h"
#include "ftecmath.h"
Include dependency graph for evaluate.c:

Go to the source code of this file.

Functions

static RETSIGTYPE sig_matherr ()
 
static struct dvecapply_func ()
 
static struct dvecevfunc ()
 
static char * mkcname ()
 
static struct dvecdoop ()
 
static void fixdims ()
 
struct dvecft_evaluate (struct pnode *node)
 
struct dvlistft_dvlist (struct pnode *p0)
 
struct dvecop_plus (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_minus (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_comma (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_times (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_mod (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_divide (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_power (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_eq (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_gt (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_lt (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_ge (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_le (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_ne (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_and (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_or (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_range (struct pnode *arg1, struct pnode *arg2)
 
struct dvecop_ind (struct pnode *arg1, struct pnode *arg2)
 
static struct dvecapply_func (struct func *func, struct pnode *arg)
 
static struct dvecevfunc (struct dvec *v, struct func *func)
 
struct dvecop_uminus (struct pnode *arg)
 
struct dvecop_not (struct pnode *arg)
 
static char * mkcname (char what, char *v1, char *v2)
 
static struct dvecdoop (char what, char *(*func)(), struct pnode *arg1, struct pnode *arg2)
 
static void fixdims (struct dvec *r, struct dvec *v1, struct dvec *v2)
 

Function Documentation

static struct dvec* apply_func ( )
static
static struct dvec* apply_func ( struct func func,
struct pnode arg 
)
static

Definition at line 534 of file evaluate.c.

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 }
static char buf[MAXPROMPT]
Definition: arg.c:18
#define BSIZE_SP
Definition: misc.h:19
struct dvlist * v_link2
Definition: ftedata.h:44
void vec_newtemp()
struct plot * plot_cur
Definition: vectors.c:43
Definition: ftedata.h:49
#define alloc(type)
Definition: cdmacs.h:21
char * copy()
struct dvlist * dl_next
Definition: ftedata.h:51
FILE * cp_err
Definition: help.c:101
#define NULL
Definition: spdefs.h:121
struct dvec * vec_fromplot()
struct dvec * ft_evaluate(struct pnode *node)
Definition: evaluate.c:62
Definition: ftedata.h:24
struct dvec * dl_dvec
Definition: ftedata.h:50
char * v_name
Definition: ftedata.h:25
struct dvec * pn_value
Definition: fteparse.h:18
static struct dvec * evfunc()
int v_length
Definition: ftedata.h:34
Definition: cddefs.h:192
char *(* fu_func)()
Definition: fteparse.h:39
struct dvec * vec_copy()
static struct dvec* doop ( )
static
static struct dvec* doop ( char  what,
char *(*)()  func,
struct pnode arg1,
struct pnode arg2 
)
static

Definition at line 729 of file evaluate.c.

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 }
static RETSIGTYPE sig_matherr()
#define VF_REAL
Definition: fteconst.h:39
static void fixdims()
struct dvlist * v_link2
Definition: ftedata.h:44
void vec_newtemp()
if(TDesc==NULL)
Definition: cd.c:1326
Definition: cpstd.h:29
#define alloc(type)
Definition: cdmacs.h:21
complex * v_compdata
Definition: ftedata.h:29
FILE * cp_err
Definition: help.c:101
char * tmalloc()
void txfree()
#define NULL
Definition: spdefs.h:121
GRIDTYPE v_gridtype
Definition: ftedata.h:32
char * v_defcolor
Definition: ftedata.h:39
struct dvec * ft_evaluate(struct pnode *node)
Definition: evaluate.c:62
#define isreal(v)
Definition: ftedata.h:54
Definition: ftedata.h:24
char * v_name
Definition: ftedata.h:25
#define imagpart(cval)
Definition: cpstd.h:36
Definition: fteparse.h:37
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()
#define VF_COMPLEX
Definition: fteconst.h:40
static char * mkcname()
#define realpart(cval)
Definition: cpstd.h:35
static struct dvec* evfunc ( )
static
static struct dvec* evfunc ( struct dvec v,
struct func func 
)
static

Definition at line 595 of file evaluate.c.

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 }
#define eq(a, b)
Definition: misc.h:29
static RETSIGTYPE sig_matherr()
#define VF_REAL
Definition: fteconst.h:39
void vec_newtemp()
struct plot * plot_cur
Definition: vectors.c:43
Definition: cpstd.h:29
int v_dims[MAXDIMS]
Definition: ftedata.h:41
char * fu_name
Definition: fteparse.h:38
#define alloc(type)
Definition: cdmacs.h:21
complex * v_compdata
Definition: ftedata.h:29
FILE * cp_err
Definition: help.c:101
#define NULL
Definition: spdefs.h:121
Definition: types.c:18
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
#define isreal(v)
Definition: ftedata.h:54
Definition: ftedata.h:24
char * v_name
Definition: ftedata.h:25
#define VF_MAXGIVEN
Definition: fteconst.h:45
bool ft_evdb
Definition: options.c:27
return(True)
int v_type
Definition: ftedata.h:26
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
Definition: cddefs.h:192
#define VF_COMPLEX
Definition: fteconst.h:40
char *(* fu_func)()
Definition: fteparse.h:39
static char * mkcname()
#define VF_MINGIVEN
Definition: fteconst.h:44
static void fixdims ( )
static
static void fixdims ( struct dvec r,
struct dvec v1,
struct dvec v2 
)
static

Definition at line 908 of file evaluate.c.

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 }
int v_dims[MAXDIMS]
Definition: ftedata.h:41
struct dvec * v_scale
Definition: ftedata.h:45
int v_type
Definition: ftedata.h:26
int v_numdims
Definition: ftedata.h:40
struct dvlist* ft_dvlist ( struct pnode p0)

Definition at line 105 of file evaluate.c.

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 }
struct dvlist * v_link2
Definition: ftedata.h:44
Definition: ftedata.h:49
#define alloc(type)
Definition: cdmacs.h:21
struct dvlist * dl_next
Definition: ftedata.h:51
void inp_pnfree()
#define NULL
Definition: spdefs.h:121
struct pnode * pn_next
Definition: fteparse.h:23
struct dvec * ft_evaluate(struct pnode *node)
Definition: evaluate.c:62
Definition: ftedata.h:24
void vec_dlfree()
Definition: fteparse.h:16
struct dvec* ft_evaluate ( struct pnode node)

Definition at line 62 of file evaluate.c.

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 }
struct dvlist * v_link2
Definition: ftedata.h:44
struct func * pn_func
Definition: fteparse.h:19
char * pn_name
Definition: fteparse.h:17
char * copy()
FILE * cp_err
Definition: help.c:101
static struct dvec * apply_func()
Definition: cddefs.h:237
void txfree()
#define NULL
Definition: spdefs.h:121
struct dvec *(* op_func)()
Definition: fteparse.h:32
struct op * pn_op
Definition: fteparse.h:20
Definition: ftedata.h:24
char * v_name
Definition: ftedata.h:25
bool ft_evdb
Definition: options.c:27
struct dvec * pn_value
Definition: fteparse.h:18
char op_arity
Definition: fteparse.h:31
int v_length
Definition: ftedata.h:34
struct pnode * pn_right
Definition: fteparse.h:22
struct pnode * pn_left
Definition: fteparse.h:21
static char* mkcname ( )
static
static char* mkcname ( char  what,
char *  v1,
char *  v2 
)
static

Definition at line 700 of file evaluate.c.

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 }
static char buf[MAXPROMPT]
Definition: arg.c:18
#define BSIZE_SP
Definition: misc.h:19
Definition: cddefs.h:119
char * copy()
struct dvec* op_and ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 262 of file evaluate.c.

265 {
266  return (doop('&', cx_and, arg1, arg2));
267 }
static struct dvec * doop()
char * cx_and()
struct dvec* op_comma ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 163 of file evaluate.c.

166 {
167  return (doop(',', cx_comma, arg1, arg2));
168 }
static struct dvec * doop()
char * cx_comma()
struct dvec* op_divide ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 190 of file evaluate.c.

193 {
194  return (doop('/', cx_divide, arg1, arg2));
195 }
static struct dvec * doop()
char * cx_divide()
struct dvec* op_eq ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 208 of file evaluate.c.

211 {
212  return (doop('=', cx_eq, arg1, arg2));
213 }
static struct dvec * doop()
char * cx_eq()
struct dvec* op_ge ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 235 of file evaluate.c.

238 {
239  return (doop('G', cx_ge, arg1, arg2));
240 }
static struct dvec * doop()
char * cx_ge()
struct dvec* op_gt ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 217 of file evaluate.c.

220 {
221  return (doop('>', cx_gt, arg1, arg2));
222 }
static struct dvec * doop()
char * cx_gt()
struct dvec* op_ind ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 384 of file evaluate.c.

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 }
void vec_newtemp()
if(TDesc==NULL)
Definition: cd.c:1326
Definition: cpstd.h:29
int v_dims[MAXDIMS]
Definition: ftedata.h:41
#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
FILE * cp_err
Definition: help.c:101
char * tmalloc()
#define NULL
Definition: spdefs.h:121
GRIDTYPE v_gridtype
Definition: ftedata.h:32
char * v_defcolor
Definition: ftedata.h:39
struct dvec * ft_evaluate(struct pnode *node)
Definition: evaluate.c:62
#define isreal(v)
Definition: ftedata.h:54
Definition: ftedata.h:24
char * v_name
Definition: ftedata.h:25
#define imagpart(cval)
Definition: cpstd.h:36
int v_type
Definition: ftedata.h:26
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
static char * mkcname()
#define realpart(cval)
Definition: cpstd.h:35
struct dvec* op_le ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 244 of file evaluate.c.

247 {
248  return (doop('L', cx_le, arg1, arg2));
249 }
static struct dvec * doop()
char * cx_le()
struct dvec* op_lt ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 226 of file evaluate.c.

229 {
230  return (doop('<', cx_lt, arg1, arg2));
231 }
static struct dvec * doop()
char * cx_lt()
struct dvec* op_minus ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 154 of file evaluate.c.

157 {
158  return (doop('-', cx_minus, arg1, arg2));
159 }
static struct dvec * doop()
char * cx_minus()
struct dvec* op_mod ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 181 of file evaluate.c.

184 {
185  return (doop('%', cx_mod, arg1, arg2));
186 }
static struct dvec * doop()
char * cx_mod()
struct dvec* op_ne ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 253 of file evaluate.c.

256 {
257  return (doop('N', cx_ne, arg1, arg2));
258 }
static struct dvec * doop()
char * cx_ne()
struct dvec* op_not ( struct pnode arg)

Definition at line 686 of file evaluate.c.

689 {
690  return (apply_func(&func_not, arg));
691 }
static struct dvec * apply_func()
struct func func_not
Definition: parse.c:697
struct dvec* op_or ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 271 of file evaluate.c.

274 {
275  return (doop('|', cx_or, arg1, arg2));
276 }
static struct dvec * doop()
char * cx_or()
struct dvec* op_plus ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 146 of file evaluate.c.

148 {
149  return (doop('+', cx_plus, arg1, arg2));
150 }
char * cx_plus()
static struct dvec * doop()
struct dvec* op_power ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 199 of file evaluate.c.

202 {
203  return (doop('^', cx_power, arg1, arg2));
204 }
static struct dvec * doop()
char * cx_power()
struct dvec* op_range ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 288 of file evaluate.c.

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 }
void vec_newtemp()
if(TDesc==NULL)
Definition: cd.c:1326
Definition: cpstd.h:29
int v_dims[MAXDIMS]
Definition: ftedata.h:41
#define alloc(type)
Definition: cdmacs.h:21
complex * v_compdata
Definition: ftedata.h:29
FILE * cp_err
Definition: help.c:101
char * tmalloc()
struct dvec * pl_scale
Definition: ftedata.h:68
#define NULL
Definition: spdefs.h:121
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 * ft_evaluate(struct pnode *node)
Definition: evaluate.c:62
#define isreal(v)
Definition: ftedata.h:54
Definition: ftedata.h:24
char * v_name
Definition: ftedata.h:25
#define imagpart(cval)
Definition: cpstd.h:36
int v_type
Definition: ftedata.h:26
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
static char * mkcname()
#define realpart(cval)
Definition: cpstd.h:35
struct dvec* op_times ( struct pnode arg1,
struct pnode arg2 
)

Definition at line 172 of file evaluate.c.

175 {
176  return (doop('*', cx_times, arg1, arg2));
177 }
static struct dvec * doop()
char * cx_times()
struct dvec* op_uminus ( struct pnode arg)

Definition at line 677 of file evaluate.c.

680 {
681  return (apply_func(&func_uminus, arg));
682 }
static struct dvec * apply_func()
struct func func_uminus
Definition: parse.c:695
static RETSIGTYPE sig_matherr ( )
static