luke
/
ngspice
mirror of https://git.code.sf.net/p/ngspice/ngspice
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
ngspice/src/frontend/evaluate.c

829 lines
22 KiB
C
Raw Blame History

/**********
Copyright 1990 Regents of the University of California. All rights reserved.
Author: 1985 Wayne A. Christopher, U. C. Berkeley CAD Group
**********/
/*
* Convert a parse tree to a list of data vectors.
*/
#include <setjmp.h>
#include <signal.h>
#include <ngspice.h>
#include <ftedefs.h>
#include <dvec.h>
#include "evaluate.h"
/* static declarations */
static RETSIGTYPE sig_matherr(void);
static struct dvec * apply_func(struct func *func, struct pnode *arg);
static char * mkcname(char what, char *v1, char *v2);
/* We are careful here to catch SIGILL and recognise them as math errors.
* The only trouble is that the (void) signal handler we installed before will
* be lost, but that's no great loss.
*/
static jmp_buf matherrbuf;
static RETSIGTYPE
sig_matherr(void)
{
fprintf(cp_err, "Error: argument out of range for math function\n");
longjmp(matherrbuf, 1);
}
/* Note that ft_evaluate will return NULL on invalid expressions. */
/* va: NOTE: ft_evaluate returns a new vector for expressions (func, op, ...)
and an existing vector (node->pn_value) when node->pn_value != NULL.
For garbage collection caller must vec_free() expression-vector. */
struct dvec *
ft_evaluate(struct pnode *node)
{
struct dvec *d = NULL;
if (!node)
d = NULL;
else if (node->pn_value)
d = node->pn_value;
else if (node->pn_func)
d = apply_func(node->pn_func, node->pn_left);
else if (node->pn_op) {
if (node->pn_op->op_arity == 1)
d = (struct dvec *)
((*node->pn_op->op_func) (node->pn_left));
else if (node->pn_op->op_arity == 2)
d = (struct dvec *) ((*node->pn_op->op_func)
(node->pn_left, node->pn_right));
} else {
fprintf(cp_err, "ft_evaluate: Internal Error: bad node\n");
d = NULL;
}
if (d == NULL) {
return NULL;
}
if (node->pn_name && !ft_evdb && d && !d->v_link2) {
if(d->v_name)
tfree(d->v_name);
d->v_name = copy(node->pn_name);
}
if (!d->v_length) {
fprintf(cp_err, "Error: no such vector %s\n", d->v_name);
return (NULL);
} else
return (d);
}
/* Operate on two vectors, and return a third with the data, length, and flags
* fields filled in. Add it to the current plot and get rid of the two args.
*/
static struct dvec *
doop(char what,
void*(*func) (void *data1, void *data2,
short int datatype1, short int datatype2,
int length),
struct pnode *arg1,
struct pnode *arg2)
{
struct dvec *v1, *v2, *res;
complex *c1 = NULL, *c2 = NULL , lc;
double *d1 = NULL, *d2 = NULL, ld;
int length = 0, i;
void *data;
bool free1 = FALSE, free2 = FALSE, relflag = FALSE;
v1 = ft_evaluate(arg1);
v2 = ft_evaluate(arg2);
if (!v1 || !v2)
return (NULL);
/* Now the question is, what do we do when one or both of these
* has more than one vector? This is definitely not a good
* thing. For the time being don't do anything.
*/
if (v1->v_link2 || v2->v_link2) {
fprintf(cp_err, "Warning: no operations on wildcards yet.\n");
if (v1->v_link2 && v2->v_link2)
fprintf(cp_err, "\t(You couldn't do that one anyway)\n");
return (NULL);
}
/* How do we handle operations on multi-dimensional vectors?
* For now, we only allow operations between one-D vectors,
* equivalently shaped multi-D vectors, or a multi-D vector and
* a one-D vector. It's not at all clear what to do in the other cases.
* So only check shape requirement if its an operation between two multi-D
* arrays.
*/
if ((v1->v_numdims > 1) && (v2->v_numdims > 1)) {
if (v1->v_numdims != v2->v_numdims) {
fprintf(cp_err,
"Warning: operands %s and %s have incompatible shapes.\n",
v1->v_name, v2->v_name);
return (NULL);
}
for (i = 1; i < v1->v_numdims; i++) {
if ((v1->v_dims[i] != v2->v_dims[i])) {
fprintf(cp_err,
"Warning: operands %s and %s have incompatible shapes.\n",
v1->v_name, v2->v_name);
return (NULL);
}
}
}
/* This is a bad way to do this. */
switch (what) {
case '=':
case '>':
case '<':
case 'G':
case 'L':
case 'N':
case '&':
case '|':
case '~':
relflag = TRUE;
}
/* Don't bother to do type checking. Maybe this should go in at
* some point.
*/
/* Make sure we have data of the same length. */
length = ((v1->v_length > v2->v_length) ? v1->v_length : v2->v_length);
if (v1->v_length < length) {
free1 = TRUE;
if (isreal(v1)) {
ld = 0.0;
d1 = (double *) tmalloc(length * sizeof (double));
for (i = 0; i < v1->v_length; i++)
d1[i] = v1->v_realdata[i];
if (length > 0)
ld = v1->v_realdata[v1->v_length - 1];
for ( ; i < length; i++)
d1[i] = ld;
} else {
realpart(&lc) = 0.0;
imagpart(&lc) = 0.0;
c1 = (complex *) tmalloc(length * sizeof (complex));
for (i = 0; i < v1->v_length; i++)
c1[i] = v1->v_compdata[i];
if (length > 0)
lc = v1->v_compdata[v1->v_length - 1];
for ( ; i < length; i++)
c1[i] = lc;
}
} else
if (isreal(v1))
d1 = v1->v_realdata;
else
c1 = v1->v_compdata;
if (v2->v_length < length) {
free2 = TRUE;
if (isreal(v2)) {
ld = 0.0;
d2 = (double *) tmalloc(length * sizeof (double));
for (i = 0; i < v2->v_length; i++)
d2[i] = v2->v_realdata[i];
if (length > 0)
ld = v2->v_realdata[v2->v_length - 1];
for ( ; i < length; i++)
d2[i] = ld;
} else {
realpart(&lc) = 0.0;
imagpart(&lc) = 0.0;
c2 = (complex *) tmalloc(length * sizeof (complex));
for (i = 0; i < v2->v_length; i++)
c2[i] = v2->v_compdata[i];
if (length > 0)
lc = v2->v_compdata[v1->v_length - 1];
for ( ; i < length; i++)
c2[i] = lc;
}
} else
if (isreal(v2))
d2 = v2->v_realdata;
else
c2 = v2->v_compdata;
/* Some of the math routines generate SIGILL if the argument is
* out of range. Catch this here.
*/
if (setjmp(matherrbuf)) {
return (NULL);
}
(void) signal(SIGILL, (SIGNAL_FUNCTION) sig_matherr);
/* Now pass the vectors to the appropriate function. */
data = ((*func) ((isreal(v1) ? (void *) d1 : (void *) c1),
(isreal(v2) ? (void *) d2 : (void *) c2),
(isreal(v1) ? VF_REAL : VF_COMPLEX),
(isreal(v2) ? VF_REAL : VF_COMPLEX),
length));
/* Back to normal */
(void) signal(SIGILL, SIG_DFL);
if (!data)
return (NULL);
/* Make up the new vector. */
res = alloc(struct dvec);
ZERO(res,struct dvec);
if (relflag || (isreal(v1) && isreal(v2) && (func != cx_comma))) {
res->v_flags = (v1->v_flags | v2->v_flags |
VF_REAL) & ~ VF_COMPLEX;
res->v_realdata = (double *) data;
} else {
res->v_flags = (v1->v_flags | v2->v_flags |
VF_COMPLEX) & ~ VF_REAL;
res->v_compdata = (complex *) data;
}
res->v_name = mkcname(what, v1->v_name, v2->v_name);
res->v_length = length;
/* This is a non-obvious thing */
if (v1->v_scale != v2->v_scale) {
fprintf(cp_err, "Warning: scales of %s and %s are different.\n",
v1->v_name, v2->v_name);
res->v_scale = NULL;
} else
res->v_scale = v1->v_scale;
/* Copy a few useful things */
res->v_defcolor = v1->v_defcolor;
res->v_gridtype = v1->v_gridtype;
res->v_plottype = v1->v_plottype;
/* Copy dimensions. */
if (v1->v_numdims > v2->v_numdims) {
res->v_numdims = v1->v_numdims;
for (i = 0; i < v1->v_numdims; i++)
res->v_dims[i] = v1->v_dims[i];
} else {
res->v_numdims = v2->v_numdims;
for (i = 0; i < v2->v_numdims; i++)
res->v_dims[i] = v2->v_dims[i];
}
/* This depends somewhat on what the operation is. XXX Should fix */
res->v_type = v1->v_type;
vec_new(res);
/* Free the temporary data areas we used, if we allocated any. */
if (free1) {
if (isreal(v1)) {
tfree(d1);
} else {
tfree(c1);
}
}
if (free2) {
if (isreal(v2)) {
tfree(d2);
} else {
tfree(c2);
}
}
/* va: garbage collection */
if (arg1->pn_value==NULL && v1!=NULL) vec_free(v1);
if (arg2->pn_value==NULL && v2!=NULL) vec_free(v2);
return (res);
}
/* The binary operations. */
struct dvec *
op_plus(struct pnode *arg1, struct pnode *arg2)
{
return (doop('+', cx_plus, arg1, arg2));
}
struct dvec *
op_minus(struct pnode *arg1, struct pnode *arg2)
{
return (doop('-', cx_minus, arg1, arg2));
}
struct dvec *
op_comma(struct pnode *arg1, struct pnode *arg2)
{
return (doop(',', cx_comma, arg1, arg2));
}
struct dvec *
op_times(struct pnode *arg1, struct pnode *arg2)
{
return (doop('*', cx_times, arg1, arg2));
}
struct dvec *
op_mod(struct pnode *arg1, struct pnode *arg2)
{
return (doop('%', cx_mod, arg1, arg2));
}
struct dvec *
op_divide(struct pnode *arg1, struct pnode *arg2)
{
return (doop('/', cx_divide, arg1, arg2));
}
struct dvec *
op_power(struct pnode *arg1, struct pnode *arg2)
{
return (doop('^', cx_power, arg1, arg2));
}
struct dvec *
op_eq(struct pnode *arg1, struct pnode *arg2)
{
return (doop('=', cx_eq, arg1, arg2));
}
struct dvec *
op_gt(struct pnode *arg1, struct pnode *arg2)
{
return (doop('>', cx_gt, arg1, arg2));
}
struct dvec *
op_lt(struct pnode *arg1, struct pnode *arg2)
{
return (doop('<', cx_lt, arg1, arg2));
}
struct dvec *
op_ge(struct pnode *arg1, struct pnode *arg2)
{
return (doop('G', cx_ge, arg1, arg2));
}
struct dvec *
op_le(struct pnode *arg1, struct pnode *arg2)
{
return (doop('L', cx_le, arg1, arg2));
}
struct dvec *
op_ne(struct pnode *arg1, struct pnode *arg2)
{
return (doop('N', cx_ne, arg1, arg2));
}
struct dvec *
op_and(struct pnode *arg1, struct pnode *arg2)
{
return (doop('&', cx_and, arg1, arg2));
}
struct dvec *
op_or(struct pnode *arg1, struct pnode *arg2)
{
return (doop('|', cx_or, arg1, arg2));
}
/* This is an odd operation. The first argument is the name of a vector, and
* the second is a range in the scale, so that v(1)[[10, 20]] gives all the
* values of v(1) for which the TIME value is between 10 and 20. If there is
* one argument it picks out the values which have that scale value.
* NOTE that we totally ignore multi-dimensionality here -- the result is
* a 1-dim vector.
*/
struct dvec *
op_range(struct pnode *arg1, struct pnode *arg2)
{
struct dvec *v, *ind, *res, *scale; /* , *nscale; */
double up, low, td;
int len, i, j;
bool rev = FALSE;
v = ft_evaluate(arg1);
ind = ft_evaluate(arg2);
if (!v || !ind)
return (NULL);
scale = v->v_scale;
if (!scale)
scale = v->v_plot->pl_scale;
if (!scale) {
fprintf(cp_err, "Error: no scale for vector %s\n", v->v_name);
return (NULL);
}
if (ind->v_length != 1) {
fprintf(cp_err, "Error: strange range specification\n");
return (NULL);
}
if (isreal(ind)) {
up = low = *ind->v_realdata;
} else {
up = imagpart(ind->v_compdata);
low = realpart(ind->v_compdata);
}
if (up < low) {
td = up;
up = low;
low = td;
rev = TRUE;
}
for (i = len = 0; i < scale->v_length; i++) {
td = isreal(scale) ? scale->v_realdata[i] :
realpart(&scale->v_compdata[i]);
if ((td <= up) && (td >= low))
len++;
}
res = alloc(struct dvec);
ZERO(res,struct dvec);
res->v_name = mkcname('R', v->v_name, ind->v_name);
res->v_type = v->v_type;
res->v_flags = v->v_flags;
res->v_gridtype = v->v_gridtype;
res->v_plottype = v->v_plottype;
res->v_defcolor = v->v_defcolor;
res->v_length = len;
res->v_scale = /* nscale; */ scale;
/* Dave says get rid of this
res->v_numdims = v->v_numdims;
for (i = 0; i < v->v_numdims; i++)
res->v_dims[i] = v->v_dims[i];
*/
res->v_numdims = 1;
res->v_dims[0] = len;
if (isreal(res))
res->v_realdata = (double *) tmalloc(sizeof (double) * len);
else
res->v_compdata = (complex *) tmalloc(sizeof (complex) * len);
/* Toss in the data */
j = 0;
for (i = (rev ? v->v_length - 1 : 0); i != (rev ? -1 : v->v_length);
rev ? i-- : i++) {
td = isreal(scale) ? scale->v_realdata[i] :
realpart(&scale->v_compdata[i]);
if ((td <= up) && (td >= low)) {
if (isreal(res)) {
res->v_realdata[j] = v->v_realdata[i];
} else {
realpart(&res->v_compdata[j]) =
realpart(&v->v_compdata[i]);
imagpart(&res->v_compdata[j]) =
imagpart(&v->v_compdata[i]);
}
j++;
}
}
if (j != len)
fprintf(cp_err, "Error: something funny..\n");
/* Note that we DON'T do a vec_new, since we want this vector to be
* invisible to everybody except the result of this operation.
* Doing this will cause a lot of core leaks, though. XXX
*/
vec_new(res);
/* va: garbage collection */
if (arg1->pn_value==NULL && v!=NULL) vec_free(v);
if (arg1->pn_value==NULL && ind!=NULL) vec_free(ind);
return (res);
}
/* This is another operation we do specially -- if the argument is a vector of
* dimension n, n > 0, the result will be either a vector of dimension n - 1,
* or a vector of dimension n with only a certain range of vectors present.
*/
struct dvec *
op_ind(struct pnode *arg1, struct pnode *arg2)
{
struct dvec *v, *ind, *res;
int length, newdim, i, j, k, up, down;
int majsize, blocksize;
bool rev = FALSE;
v = ft_evaluate(arg1);
ind = ft_evaluate(arg2);
if (!v || !ind)
return (NULL);
/* First let's check to make sure that the vector is consistent */
if (v->v_numdims > 1) {
for (i = 0, j = 1; i < v->v_numdims; i++)
j *= v->v_dims[i];
if (v->v_length != j) {
fprintf(cp_err,
"op_ind: Internal Error: len %d should be %d\n",
v->v_length, j);
return (NULL);
}
} else {
/* Just in case we were sloppy */
v->v_numdims = 1;
v->v_dims[0] = v->v_length;
if (v->v_length <= 1) {
fprintf(cp_err, "Error: nostrchring on a scalar (%s)\n",
v->v_name);
return (NULL);
}
}
if (ind->v_length != 1) {
fprintf(cp_err, "Error:strchr %s is not of length 1\n",
ind->v_name);
return (NULL);
}
majsize = v->v_dims[0];
blocksize = v->v_length / majsize;
/* Now figure out if we should put the dim down by one. Because of the
* way we parse thestrchr, we figure that if the value is complex
* (e.g, "[1,2]"), the guy meant a range. This is sort of bad though.
*/
if (isreal(ind)) {
newdim = v->v_numdims - 1;
down = up = ind->v_realdata[0];
} else {
newdim = v->v_numdims;
down = realpart(&ind->v_compdata[0]);
up = imagpart(&ind->v_compdata[0]);
}
if (up < down) {
i = up;
up = down;
down = i;
rev = TRUE;
}
if (up < 0) {
fprintf(cp_err, "Warning: upper limit %d should be 0\n", up);
up = 0;
}
if (up >= majsize) {
fprintf(cp_err, "Warning: upper limit %d should be %d\n", up,
majsize - 1);
up = majsize - 1;
}
if (down < 0) {
fprintf(cp_err, "Warning: lower limit %d should be 0\n", down);
down = 0;
}
if (down >= majsize) {
fprintf(cp_err, "Warning: lower limit %d should be %d\n", down,
majsize - 1);
down = majsize - 1;
}
if (up == down)
length = blocksize;
else
length = blocksize * (up - down + 1);
/* Make up the new vector. */
res = alloc(struct dvec);
ZERO(res,struct dvec);
res->v_name = mkcname('[', v->v_name, ind->v_name);
res->v_type = v->v_type;
res->v_flags = v->v_flags;
res->v_defcolor = v->v_defcolor;
res->v_gridtype = v->v_gridtype;
res->v_plottype = v->v_plottype;
res->v_length = length;
res->v_numdims = newdim;
if (up != down) {
for (i = 0; i < newdim; i++)
res->v_dims[i] = v->v_dims[i];
res->v_dims[0] = up - down + 1;
} else {
for (i = 0; i < newdim; i++)
res->v_dims[i] = v->v_dims[i + 1];
}
if (isreal(res))
res->v_realdata = (double *) tmalloc(sizeof (double) * length);
else
res->v_compdata = (complex *) tmalloc(sizeof (complex) * length);
/* And toss in the new data */
for (j = 0; j < up - down + 1; j++) {
if (rev)
k = (up - down) - j;
else
k = j;
for (i = 0; i < blocksize; i++)
if (isreal(res))
res->v_realdata[k * blocksize + i] =
v->v_realdata[(down + j) * blocksize + i];
else {
realpart(&res->v_compdata[k * blocksize + i]) =
realpart(&v->v_compdata[(down + j) * blocksize + i]);
imagpart(&res->v_compdata[k * blocksize + i]) =
imagpart(&v->v_compdata[(down + j) * blocksize + i]);
}
}
/* This is a problem -- the old scale will be no good. I guess we
* should make an altered copy of the old scale also.
*/
/* Even though the old scale is no good and we should somehow decide
* on a new scale, using the vector as its own scale is not the
* solution.
*/
/*
* res->v_scale = res;
*/
vec_new(res);
/* va: garbage collection */
if (arg1->pn_value==NULL && v!=NULL) vec_free(v);
if (arg1->pn_value==NULL && ind!=NULL) vec_free(ind);
return (res);
}
/* Apply a function to an argument. Complex functions are called as follows:
* cx_something(data, type, length, &newlength, &newtype),
* and returns a char * that is cast to complex or double.
*/
static struct dvec *
apply_func(struct func *func, struct pnode *arg)
{
struct dvec *v, *t, *newv = NULL, *end = NULL;
int len, i;
short type;
char *data, buf[BSIZE_SP];
/* Special case. This is not good -- happens when vm(), etc are used
* and it gets caught as a user-definable function. Usually v()
* is caught in the parser.
*/
if (!func->fu_func) {
if (!arg->pn_value /* || (arg->pn_value->v_length != 1) XXX */) {
fprintf(cp_err, "Error: bad v() syntax\n");
return (NULL);
}
(void) sprintf(buf, "v(%s)", arg->pn_value->v_name);
t = vec_fromplot(buf, plot_cur);
if (!t) {
fprintf(cp_err, "Error: no such vector %s\n", buf);
return (NULL);
}
t = vec_copy(t);
vec_new(t);
return (t);
}
v = ft_evaluate(arg);
if (v == NULL)
return (NULL);
for (; v; v = v->v_link2) {
/* Some of the math routines generate SIGILL if the argument is
* out of range. Catch this here.
*/
if (setjmp(matherrbuf)) {
(void) signal(SIGILL, SIG_DFL);
return (NULL);
}
(void) signal(SIGILL, (SIGNAL_FUNCTION) sig_matherr);
#if 0
/* FIXME: The call to (*func->fu_func) has too many arguments;
hence the compiler quits. How to circumvent this (without
losing function prototypes)? For now, these functions have
been disabled. */
if (eq(func->fu_name, "interpolate")
|| eq(func->fu_name, "deriv")) /* Ack */
{
data = ((*func->fu_func) ((isreal(v) ?
(void *) v->v_realdata :
(void *) v->v_compdata),
(short) (isreal(v) ? VF_REAL :
VF_COMPLEX),
v->v_length, &len, &type,
v->v_plot, plot_cur, v->v_dims[0]));
} else {
#endif
data = ((*func->fu_func) ((isreal(v) ? (void *)
v->v_realdata :
(void *) v->v_compdata),
(short) (isreal(v) ? VF_REAL :
VF_COMPLEX),
v->v_length, &len, &type));
#if 0
}
#endif
/* Back to normal */
(void) signal(SIGILL, SIG_DFL);
if (!data)
return (NULL);
t = alloc(struct dvec);
ZERO(t,struct dvec);
t->v_flags = (v->v_flags & ~VF_COMPLEX & ~VF_REAL &
~VF_PERMANENT & ~VF_MINGIVEN & ~VF_MAXGIVEN);
t->v_flags |= type;
#ifdef FTEDEBUG
if (ft_evdb)
fprintf(cp_err,
"apply_func: func %s to %s len %d, type %d\n",
func->fu_name, v->v_name, len, type);
#endif
if (isreal(t))
t->v_realdata = (double *) data;
else
t->v_compdata = (complex *) data;
if (eq(func->fu_name, "minus"))
t->v_name = mkcname('a', func->fu_name, v->v_name);
else if (eq(func->fu_name, "not"))
t->v_name = mkcname('c', func->fu_name, v->v_name);
else
t->v_name = mkcname('b', v->v_name, (char *) NULL);
t->v_type = v->v_type; /* This is strange too. */
t->v_length = len;
t->v_scale = v->v_scale;
/* Copy a few useful things */
t->v_defcolor = v->v_defcolor;
t->v_gridtype = v->v_gridtype;
t->v_plottype = v->v_plottype;
t->v_numdims = v->v_numdims;
for (i = 0; i < t->v_numdims; i++)
t->v_dims[i] = v->v_dims[i];
vec_new(t);
if (end)
end->v_link2 = t;
else
newv = t;
end = t;
}
/* va: garbage collection */
if (arg->pn_value==NULL && v!=NULL) vec_free(v);
return (newv);
}
/* The unary minus operation. */
struct dvec *
op_uminus(struct pnode *arg)
{
return (apply_func(&func_uminus, arg));
}
struct dvec *
op_not(struct pnode *arg)
{
return (apply_func(&func_not, arg));
}
/* Create a reasonable name for the result of a function application, etc.
* The what values 'a' and 'b' mean "make a function name" and "make a
* unary minus", respectively.
*/
static char *
mkcname(char what, char *v1, char *v2)
{
char buf[BSIZE_SP], *s;
if (what == 'a')
(void) sprintf(buf, "%s(%s)", v1, v2);
else if (what == 'b')
(void) sprintf(buf, "-(%s)", v1);
else if (what == 'c')
(void) sprintf(buf, "~(%s)", v1);
else if (what == '[')
(void) sprintf(buf, "%s[%s]", v1, v2);
else if (what == 'R')
(void) sprintf(buf, "%s[[%s]]", v1, v2);
else
(void) sprintf(buf, "(%s)%c(%s)", v1, what, v2);
s = copy(buf);
return (s);
}
Reference in New Issue View Git Blame Copy Permalink