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 dvec *	apply_func ()
static struct dvec *	evfunc ()
static char *	mkcname ()
static struct dvec *	doop ()
static void	fixdims ()
struct dvec *	ft_evaluate (struct pnode *node)
struct dvlist *	ft_dvlist (struct pnode *p0)
struct dvec *	op_plus (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_minus (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_comma (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_times (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_mod (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_divide (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_power (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_eq (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_gt (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_lt (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_ge (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_le (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_ne (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_and (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_or (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_range (struct pnode *arg1, struct pnode *arg2)
struct dvec *	op_ind (struct pnode *arg1, struct pnode *arg2)
static struct dvec *	apply_func (struct func *func, struct pnode *arg)
static struct dvec *	evfunc (struct dvec *v, struct func *func)
struct dvec *	op_uminus (struct pnode *arg)
struct dvec *	op_not (struct pnode *arg)
static char *	mkcname (char what, char *v1, char *v2)
static struct dvec *	doop (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.

{
    struct dvec *v, *t, *newv;
    struct dvlist *dl, *tl, *tl0;
    char 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)) {
            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_newtemp(t);
        return (t);
    }
    v = ft_evaluate(arg);
    if (v == NULL)
        return (NULL);

    if (v->v_link2) {
        tl0 = NULL;
        for (dl = v->v_link2; dl; dl = dl->dl_next) {
            v = evfunc(dl->dl_dvec,func);
            if (v) {
                if (!tl0)
                    tl0 = tl = alloc(struct dvlist);
                else {
                    tl->dl_next = alloc(struct dvlist);
                    tl = tl->dl_next;
                }
                tl->dl_dvec = v;
            }
        }
        if (tl0) {
            newv = alloc(struct dvec);
            vec_newtemp(newv);
            newv->v_link2 = tl0;
            newv->v_name = copy("list");
            return (newv);
        }
        else
            return (NULL);
    }
    return (evfunc(v,func));
}

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.

{
    struct dvec *v1, *v2, *res;
    complex *c1, *c2, lc;
    double *d1, *d2, ld;
    int length, i;
    char *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);
    }
    
    /* 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;
    }

#ifdef HAVE_SIGS_AND_LJMP
    /* 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, (RETSIGTYPE(*)())sig_matherr);
#endif

    /* Now pass the vectors to the appropriate function. */
    data = (char *) ((*func) ((isreal(v1) ? (char *) d1 : (char *) c1),
                  (isreal(v2) ? (char *) d2 : (char *) c2),
                  (isreal(v1) ? VF_REAL : VF_COMPLEX),
                  (isreal(v2) ? VF_REAL : VF_COMPLEX),
                  length));
#ifdef HAVE_SIGS_AND_LJMP
    /* Back to normal */
    (void) signal(SIGILL, SIG_DFL);
#endif

    if (!data) return NULL;

    /* Make up the new vector. */
    res = alloc(struct dvec);

    if (relflag || (isreal(v1) && isreal(v2) && (cx_comma != func))) {

        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;

    fixdims(res,v1,v2);

    /* Copy a few useful things */
    res->v_defcolor = v1->v_defcolor;
    res->v_gridtype = v1->v_gridtype;
    res->v_plottype = v1->v_plottype;

    vec_newtemp(res);

    /* Free the temporary data areas we used, if we allocated any. */
    if (free1) {
        if (isreal(v1))
            txfree((char*)d1);
        else
            txfree((char*)c1);
    }
    if (free2) {
        if (isreal(v2))
            txfree((char*)d2);
        else
            txfree((char*)c2);
    }

    return (res);
}

static struct dvec* evfunc ( )

static

static struct dvec* evfunc ( struct dvec *  v, struct func *  func  )

static

Definition at line 595 of file evaluate.c.

{
    struct dvec *t;
    char *data;
    int len, i;
    short type;

#ifdef HAVE_SIGS_AND_LJMP
    /* 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, (RETSIGTYPE(*)())sig_matherr);
#endif

    if (eq(func->fu_name, "interpolate")
            || eq(func->fu_name, "deriv"))       /* Ack */
        data = (char *) ((*func->fu_func) ((isreal(v) ? (char *)
            v->v_realdata : (char *) v->v_compdata), 
            (short) (isreal(v) ? VF_REAL : VF_COMPLEX),
            v->v_length, &len, &type, v->v_plot,
            plot_cur));
    else
        data = (char *) ((*func->fu_func) ((isreal(v) ? (char *)
            v->v_realdata : (char *) v->v_compdata), 
            (short) (isreal(v) ? VF_REAL : VF_COMPLEX),
            v->v_length, &len, &type));
#ifdef HAVE_SIGS_AND_LJMP
    /* Back to normal */
    (void) signal(SIGILL, SIG_DFL);
#endif

    if (!data)
        return (NULL);

    t = alloc(struct dvec);
    vec_newtemp(t);

    t->v_flags = (v->v_flags & ~VF_COMPLEX & ~VF_REAL &
            ~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];

    return (t);
}

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.

{
    int i;

    if (v1->v_numdims >= v2->v_numdims) {
        for (i = 0; i < v1->v_numdims; i++)
            r->v_dims[i] = v1->v_dims[i];
        r->v_numdims = v1->v_numdims;
        r->v_scale = v1->v_scale;
        r->v_type = v1->v_type;
    }
    else {
        for (i = 0; i < v2->v_numdims; i++)
            r->v_dims[i] = v2->v_dims[i];
        r->v_numdims = v2->v_numdims;
        r->v_scale = v2->v_scale;
        r->v_type = v2->v_type;
    }
}

struct dvlist* ft_dvlist

(

struct pnode *

p0

)

Definition at line 105 of file evaluate.c.

{
    struct dvlist *dl0 = NULL, *dl, *dll;
    struct dvec *v;
    struct pnode *pn;

    for (pn = p0; pn; pn = pn->pn_next) {
        if ((v = ft_evaluate(pn)) == NULL) {
            vec_dlfree(dl0);
            inp_pnfree(p0);
            return (NULL);
        }
        if (!dl0)
            dl0 = dl = alloc(struct dvlist);
        else {
            dl->dl_next = alloc(struct dvlist);
            dl = dl->dl_next;
        }
        if (v->v_link2) {
            for (dll = v->v_link2; dll; dll = dll->dl_next) {
                dl->dl_dvec = dll->dl_dvec;
                if (dll->dl_next) {
                    dl->dl_next = alloc(struct dvlist);
                    dl = dl->dl_next;
                }
            }
        }
        else
            dl->dl_dvec = v;
    }
    inp_pnfree(p0);
    return (dl0);
}

struct dvec* ft_evaluate

(

struct pnode *

node

)

Definition at line 62 of file evaluate.c.

{
    struct dvec *d;

    if (!node)
        return (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");
        return (NULL);
    }

    if (!d) {
        return NULL;
    }

    if (node->pn_name && !ft_evdb) {
        txfree(d->v_name);
        d->v_name = copy(node->pn_name);
    }
    
    if (!d->v_length && !d->v_link2) {
        fprintf(cp_err, "Error: no such vector %s\n", d->v_name);
        return (NULL);
    }
    return (d);
}

static char* mkcname ( )

static

static char* mkcname ( char  what, char *  v1, char *  v2  )

static

Definition at line 700 of file evaluate.c.

{
    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);
}

struct dvec* op_and	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 262 of file evaluate.c.

{
    return (doop('&', cx_and, arg1, arg2));
}

struct dvec* op_comma	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 163 of file evaluate.c.

{
    return (doop(',', cx_comma, arg1, arg2));
}

struct dvec* op_divide	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 190 of file evaluate.c.

{
    return (doop('/', cx_divide, arg1, arg2));
}

struct dvec* op_eq	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 208 of file evaluate.c.

{
    return (doop('=', cx_eq, arg1, arg2));
}

struct dvec* op_ge	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 235 of file evaluate.c.

{
    return (doop('G', cx_ge, arg1, arg2));
}

struct dvec* op_gt	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 217 of file evaluate.c.

{
    return (doop('>', cx_gt, arg1, arg2));
}

struct dvec* op_ind	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 384 of file evaluate.c.

{
    struct dvec *v, *ind, *res;
    int length, i, j, k, up, down;
    int majsize, blocksize;
    bool rev = false, newdim;

    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: no indexing on a scalar (%s)\n",
                    v->v_name);
            return (NULL);
        }
    }

    if (ind->v_length != 1) {
        fprintf(cp_err, "Error: index %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 the index, 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 = true;
        down = up = ind->v_realdata[0];
        length = blocksize;
    }
    else {
        newdim = false;
        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;
        }
        length = blocksize * (up - down + 1);
    }

    /* Make up the new vector. */
    res = alloc(struct dvec);
    res->v_flags = v->v_flags;
    res->v_name = mkcname('[', v->v_name, ind->v_name);
    res->v_defcolor = v->v_defcolor;
    res->v_gridtype = v->v_gridtype;
    res->v_plottype = v->v_plottype;
    res->v_type = v->v_type;
    res->v_length = length;
    if (newdim) {
        res->v_numdims = v->v_numdims - 1;
        for (i = 0; i < res->v_numdims; i++)
            res->v_dims[i] = v->v_dims[i + 1];
    }
    else {
        res->v_numdims = v->v_numdims;
        res->v_dims[0] = up - down + 1;
        for (i = 1; i < res->v_numdims; i++)
            res->v_dims[i] = v->v_dims[i];
    }

    /* And toss in the new data */
    
    if (isreal(res)) {
        double *src, *dst;

        res->v_realdata = (double *) tmalloc(sizeof(double) * length);
        src = v->v_realdata + up*blocksize;
        dst = res->v_realdata + (rev ? 0 : up - down)*blocksize;
        for (j = up - down; j >= 0; j--) {
            DCOPY(src,dst,blocksize);
            src -= blocksize;
            dst += (rev ? blocksize : -blocksize);
        }
    }
    else {
        complex *src, *dst;

        res->v_compdata = (complex *) tmalloc(sizeof(complex) * length);
        src = v->v_compdata + up*blocksize;
        dst = res->v_compdata + (rev ? 0 : up - down)*blocksize;
        for (j = up - down; j >= 0; j--) {
            CCOPY(src,dst,blocksize);
            src -= blocksize;
            dst += (rev ? blocksize : -blocksize);
        }
    }
    
    /* This is a problem -- the old scale will be no good.  I guess we
     * should make an altered copy of the old scale also.
     */
    res->v_scale = NULL;

    vec_newtemp(res);
    return (res);
}

struct dvec* op_le	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 244 of file evaluate.c.

{
    return (doop('L', cx_le, arg1, arg2));
}

struct dvec* op_lt	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 226 of file evaluate.c.

{
    return (doop('<', cx_lt, arg1, arg2));
}

struct dvec* op_minus	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 154 of file evaluate.c.

{
    return (doop('-', cx_minus, arg1, arg2));
}

struct dvec* op_mod	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 181 of file evaluate.c.

{
    return (doop('%', cx_mod, arg1, arg2));
}

struct dvec* op_ne	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 253 of file evaluate.c.

{
    return (doop('N', cx_ne, arg1, arg2));
}

struct dvec* op_not

(

struct pnode *

arg

)

Definition at line 686 of file evaluate.c.

{
    return (apply_func(&func_not, arg));
}

struct dvec* op_or	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 271 of file evaluate.c.

{
    return (doop('|', cx_or, arg1, arg2));
}

struct dvec* op_plus	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 146 of file evaluate.c.

{
    return (doop('+', cx_plus, arg1, arg2));
}

struct dvec* op_power	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 199 of file evaluate.c.

{
    return (doop('^', cx_power, arg1, arg2));
}

struct dvec* op_range	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 288 of file evaluate.c.

{
    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);
    res->v_flags = v->v_flags;
    res->v_name = mkcname('R', v->v_name, ind->v_name);
    res->v_defcolor = v->v_defcolor;
    res->v_gridtype = v->v_gridtype;
    res->v_plottype = v->v_plottype;
    res->v_type = v->v_type;
    res->v_length = len;
    res->v_scale = /* nscale; */ scale;
    res->v_numdims = v->v_numdims;
    for (i = 0; i < v->v_numdims; i++)
        res->v_dims[i] = v->v_dims[i];

    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");

    vec_newtemp(res);
    return (res);
}

struct dvec* op_times	(	struct pnode *	arg1,
		struct pnode *	arg2
	)

Definition at line 172 of file evaluate.c.

{
    return (doop('*', cx_times, arg1, arg2));
}

struct dvec* op_uminus

(

struct pnode *

arg

)

Definition at line 677 of file evaluate.c.

{
    return (apply_func(&func_uminus, arg));
}

static RETSIGTYPE sig_matherr ( )

static