File: [local] / OpenXM_contrib / gnuplot / Attic / internal.c (download)
Revision 1.1.1.3 (vendor branch), Mon Sep 15 07:09:25 2003 UTC (20 years, 11 months ago) by ohara
Branch: GNUPLOT
CVS Tags: VERSION_3_7_3, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX Changes since 1.1.1.2: +2 -2
lines
Import gnuplot 3.7.3
|
#ifndef lint
static char *RCSid = "$Id: internal.c,v 1.7.2.1 2002/05/16 16:42:56 broeker Exp $";
#endif
/* GNUPLOT - internal.c */
/*[
* Copyright 1986 - 1993, 1998 Thomas Williams, Colin Kelley
*
* Permission to use, copy, and distribute this software and its
* documentation for any purpose with or without fee is hereby granted,
* provided that the above copyright notice appear in all copies and
* that both that copyright notice and this permission notice appear
* in supporting documentation.
*
* Permission to modify the software is granted, but not the right to
* distribute the complete modified source code. Modifications are to
* be distributed as patches to the released version. Permission to
* distribute binaries produced by compiling modified sources is granted,
* provided you
* 1. distribute the corresponding source modifications from the
* released version in the form of a patch file along with the binaries,
* 2. add special version identification to distinguish your version
* in addition to the base release version number,
* 3. provide your name and address as the primary contact for the
* support of your modified version, and
* 4. retain our contact information in regard to use of the base
* software.
* Permission to distribute the released version of the source code along
* with corresponding source modifications in the form of a patch file is
* granted with same provisions 2 through 4 for binary distributions.
*
* This software is provided "as is" without express or implied warranty
* to the extent permitted by applicable law.
]*/
#include "plot.h"
#include "fnproto.h"
/* some machines have trouble with exp(-x) for large x
* if MINEXP is defined at compile time, use gp_exp(x) instead,
* which returns 0 for exp(x) with x < MINEXP
* exp(x) will already have been defined as gp_exp(x) in plot.h
*/
#ifdef MINEXP
double gp_exp(x)
double x;
{
return (x < (MINEXP)) ? 0.0 : exp(x);
}
#endif
TBOOLEAN undefined;
static void int_check __PROTO((struct value * v));
struct value stack[STACK_DEPTH];
int s_p = -1; /* stack pointer */
/*
* System V and MSC 4.0 call this when they wants to print an error message.
* Don't!
*/
#ifndef _CRAY
# ifdef AMIGA_SC_6_1
# define matherr __matherr
# define exception __exception
# endif /* AMIGA_SC_6_1 */
# if defined(__BORLANDC__) && __BORLANDC__ >= 0x450
# define matherr _matherr
# endif /* __BORLANDC__ >= 0x450 */
# if (defined(MSDOS) || defined(DOS386)) && defined(__TURBOC__) || defined(VMS)
int matherr()
#else
int matherr(x)
struct exception *x;
# endif /* (MSDOS || DOS386) && __TURBOC__ */
{
return (undefined = TRUE); /* don't print error message */
}
#endif /* not _CRAY */
void reset_stack()
{
s_p = -1;
}
void check_stack()
{ /* make sure stack's empty */
if (s_p != -1)
fprintf(stderr, "\n\
warning: internal error--stack not empty!\n\
(function called with too many parameters?)\n");
}
#define BAD_DEFAULT default: int_error("internal error : type neither INT or CMPLX", NO_CARET); return;
struct value *pop(x)
struct value *x;
{
if (s_p < 0)
int_error("stack underflow (function call with missing parameters?)", NO_CARET);
*x = stack[s_p--];
return (x);
}
void push(x)
struct value *x;
{
if (s_p == STACK_DEPTH - 1)
int_error("stack overflow", NO_CARET);
stack[++s_p] = *x;
}
#define ERR_VAR "undefined variable: "
void f_push(x)
union argument *x; /* contains pointer to value to push; */
{
static char err_str[sizeof(ERR_VAR) + MAX_ID_LEN] = ERR_VAR;
struct udvt_entry *udv;
udv = x->udv_arg;
if (udv->udv_undef) { /* undefined */
(void) strcpy(&err_str[sizeof(ERR_VAR) - 1], udv->udv_name);
int_error(err_str, NO_CARET);
}
push(&(udv->udv_value));
}
void f_pushc(x)
union argument *x;
{
push(&(x->v_arg));
}
void f_pushd1(x)
union argument *x;
{
push(&(x->udf_arg->dummy_values[0]));
}
void f_pushd2(x)
union argument *x;
{
push(&(x->udf_arg->dummy_values[1]));
}
void f_pushd(x)
union argument *x;
{
struct value param;
(void) pop(¶m);
push(&(x->udf_arg->dummy_values[param.v.int_val]));
}
#define ERR_FUN "undefined function: "
void f_call(x) /* execute a udf */
union argument *x;
{
static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
register struct udft_entry *udf;
struct value save_dummy;
udf = x->udf_arg;
if (!udf->at) { /* undefined */
(void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
udf->udf_name);
int_error(err_str, NO_CARET);
}
save_dummy = udf->dummy_values[0];
(void) pop(&(udf->dummy_values[0]));
execute_at(udf->at);
udf->dummy_values[0] = save_dummy;
}
void f_calln(x) /* execute a udf of n variables */
union argument *x;
{
static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
register struct udft_entry *udf;
struct value save_dummy[MAX_NUM_VAR];
int i;
int num_pop;
struct value num_params;
udf = x->udf_arg;
if (!udf->at) { /* undefined */
(void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
udf->udf_name);
int_error(err_str, NO_CARET);
}
for (i = 0; i < MAX_NUM_VAR; i++)
save_dummy[i] = udf->dummy_values[i];
/* if there are more parameters than the function is expecting */
/* simply ignore the excess */
(void) pop(&num_params);
if (num_params.v.int_val > MAX_NUM_VAR) {
/* pop the dummies that there is no room for */
num_pop = num_params.v.int_val - MAX_NUM_VAR;
for (i = 0; i < num_pop; i++)
(void) pop(&(udf->dummy_values[i]));
num_pop = MAX_NUM_VAR;
} else {
num_pop = num_params.v.int_val;
}
/* pop parameters we can use */
for (i = num_pop - 1; i >= 0; i--)
(void) pop(&(udf->dummy_values[i]));
execute_at(udf->at);
for (i = 0; i < MAX_NUM_VAR; i++)
udf->dummy_values[i] = save_dummy[i];
}
static void int_check(v)
struct value *v;
{
if (v->type != INTGR)
int_error("non-integer passed to boolean operator", NO_CARET);
}
void f_lnot()
{
struct value a;
int_check(pop(&a));
push(Ginteger(&a, !a.v.int_val));
}
void f_bnot()
{
struct value a;
int_check(pop(&a));
push(Ginteger(&a, ~a.v.int_val));
}
void f_bool()
{ /* converts top-of-stack to boolean */
int_check(&top_of_stack);
top_of_stack.v.int_val = !!top_of_stack.v.int_val;
}
void f_lor()
{
struct value a, b;
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val || b.v.int_val));
}
void f_land()
{
struct value a, b;
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val && b.v.int_val));
}
void f_bor()
{
struct value a, b;
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val | b.v.int_val));
}
void f_xor()
{
struct value a, b;
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val ^ b.v.int_val));
}
void f_band()
{
struct value a, b;
int_check(pop(&b));
int_check(pop(&a));
push(Ginteger(&a, a.v.int_val & b.v.int_val));
}
void f_uminus()
{
struct value a;
(void) pop(&a);
switch (a.type) {
case INTGR:
a.v.int_val = -a.v.int_val;
break;
case CMPLX:
a.v.cmplx_val.real =
-a.v.cmplx_val.real;
a.v.cmplx_val.imag =
-a.v.cmplx_val.imag;
break;
BAD_DEFAULT
}
push(&a);
}
void f_eq()
{
/* note: floating point equality is rare because of roundoff error! */
struct value a, b;
register int result = 0;
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val ==
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val ==
b.v.cmplx_val.real &&
b.v.cmplx_val.imag == 0.0);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (b.v.int_val == a.v.cmplx_val.real &&
a.v.cmplx_val.imag == 0.0);
break;
case CMPLX:
result = (a.v.cmplx_val.real ==
b.v.cmplx_val.real &&
a.v.cmplx_val.imag ==
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void f_ne()
{
struct value a, b;
register int result = 0;
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val !=
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val !=
b.v.cmplx_val.real ||
b.v.cmplx_val.imag != 0.0);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (b.v.int_val !=
a.v.cmplx_val.real ||
a.v.cmplx_val.imag != 0.0);
break;
case CMPLX:
result = (a.v.cmplx_val.real !=
b.v.cmplx_val.real ||
a.v.cmplx_val.imag !=
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void f_gt()
{
struct value a, b;
register int result = 0;
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val >
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val >
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (a.v.cmplx_val.real >
b.v.int_val);
break;
case CMPLX:
result = (a.v.cmplx_val.real >
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void f_lt()
{
struct value a, b;
register int result = 0;
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val <
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val <
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (a.v.cmplx_val.real <
b.v.int_val);
break;
case CMPLX:
result = (a.v.cmplx_val.real <
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void f_ge()
{
struct value a, b;
register int result = 0;
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val >=
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val >=
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (a.v.cmplx_val.real >=
b.v.int_val);
break;
case CMPLX:
result = (a.v.cmplx_val.real >=
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void f_le()
{
struct value a, b;
register int result = 0;
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
result = (a.v.int_val <=
b.v.int_val);
break;
case CMPLX:
result = (a.v.int_val <=
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
result = (a.v.cmplx_val.real <=
b.v.int_val);
break;
case CMPLX:
result = (a.v.cmplx_val.real <=
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(Ginteger(&a, result));
}
void f_plus()
{
struct value a, b, result;
(void) pop(&b);
(void) pop(&a);
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
(void) Ginteger(&result, a.v.int_val +
b.v.int_val);
break;
case CMPLX:
(void) Gcomplex(&result, a.v.int_val +
b.v.cmplx_val.real,
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
(void) Gcomplex(&result, b.v.int_val +
a.v.cmplx_val.real,
a.v.cmplx_val.imag);
break;
case CMPLX:
(void) Gcomplex(&result, a.v.cmplx_val.real +
b.v.cmplx_val.real,
a.v.cmplx_val.imag +
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(&result);
}
void f_minus()
{
struct value a, b, result;
(void) pop(&b);
(void) pop(&a); /* now do a - b */
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
(void) Ginteger(&result, a.v.int_val -
b.v.int_val);
break;
case CMPLX:
(void) Gcomplex(&result, a.v.int_val -
b.v.cmplx_val.real,
-b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
(void) Gcomplex(&result, a.v.cmplx_val.real -
b.v.int_val,
a.v.cmplx_val.imag);
break;
case CMPLX:
(void) Gcomplex(&result, a.v.cmplx_val.real -
b.v.cmplx_val.real,
a.v.cmplx_val.imag -
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(&result);
}
void f_mult()
{
struct value a, b, result;
(void) pop(&b);
(void) pop(&a); /* now do a*b */
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
(void) Ginteger(&result, a.v.int_val *
b.v.int_val);
break;
case CMPLX:
(void) Gcomplex(&result, a.v.int_val *
b.v.cmplx_val.real,
a.v.int_val *
b.v.cmplx_val.imag);
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
(void) Gcomplex(&result, b.v.int_val *
a.v.cmplx_val.real,
b.v.int_val *
a.v.cmplx_val.imag);
break;
case CMPLX:
(void) Gcomplex(&result, a.v.cmplx_val.real *
b.v.cmplx_val.real -
a.v.cmplx_val.imag *
b.v.cmplx_val.imag,
a.v.cmplx_val.real *
b.v.cmplx_val.imag +
a.v.cmplx_val.imag *
b.v.cmplx_val.real);
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(&result);
}
void f_div()
{
struct value a, b, result;
register double square;
(void) pop(&b);
(void) pop(&a); /* now do a/b */
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
if (b.v.int_val)
(void) Ginteger(&result, a.v.int_val /
b.v.int_val);
else {
(void) Ginteger(&result, 0);
undefined = TRUE;
}
break;
case CMPLX:
square = b.v.cmplx_val.real *
b.v.cmplx_val.real +
b.v.cmplx_val.imag *
b.v.cmplx_val.imag;
if (square)
(void) Gcomplex(&result, a.v.int_val *
b.v.cmplx_val.real / square,
-a.v.int_val *
b.v.cmplx_val.imag / square);
else {
(void) Gcomplex(&result, 0.0, 0.0);
undefined = TRUE;
}
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
if (b.v.int_val)
(void) Gcomplex(&result, a.v.cmplx_val.real /
b.v.int_val,
a.v.cmplx_val.imag /
b.v.int_val);
else {
(void) Gcomplex(&result, 0.0, 0.0);
undefined = TRUE;
}
break;
case CMPLX:
square = b.v.cmplx_val.real *
b.v.cmplx_val.real +
b.v.cmplx_val.imag *
b.v.cmplx_val.imag;
if (square)
(void) Gcomplex(&result, (a.v.cmplx_val.real *
b.v.cmplx_val.real +
a.v.cmplx_val.imag *
b.v.cmplx_val.imag) / square,
(a.v.cmplx_val.imag *
b.v.cmplx_val.real -
a.v.cmplx_val.real *
b.v.cmplx_val.imag) /
square);
else {
(void) Gcomplex(&result, 0.0, 0.0);
undefined = TRUE;
}
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(&result);
}
void f_mod()
{
struct value a, b;
(void) pop(&b);
(void) pop(&a); /* now do a%b */
if (a.type != INTGR || b.type != INTGR)
int_error("can only mod ints", NO_CARET);
if (b.v.int_val)
push(Ginteger(&a, a.v.int_val % b.v.int_val));
else {
push(Ginteger(&a, 0));
undefined = TRUE;
}
}
void f_power()
{
struct value a, b, result;
register int i, t, count;
register double mag, ang;
(void) pop(&b);
(void) pop(&a); /* now find a**b */
switch (a.type) {
case INTGR:
switch (b.type) {
case INTGR:
count = abs(b.v.int_val);
t = 1;
/* this ought to use bit-masks and squares, etc */
for (i = 0; i < count; i++)
t *= a.v.int_val;
if (b.v.int_val >= 0)
(void) Ginteger(&result, t);
else if (t != 0)
(void) Gcomplex(&result, 1.0 / t, 0.0);
else {
undefined = TRUE;
(void) Gcomplex(&result, 0.0, 0.0);
}
break;
case CMPLX:
if (a.v.int_val == 0) {
if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
undefined = TRUE;
}
/* return 1.0 for 0**0 */
Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
} else {
mag =
pow(magnitude(&a), fabs(b.v.cmplx_val.real));
if (b.v.cmplx_val.real < 0.0) {
if (mag != 0.0)
mag = 1.0 / mag;
else
undefined = TRUE;
}
mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
ang = b.v.cmplx_val.real * angle(&a) +
b.v.cmplx_val.imag * log(magnitude(&a));
(void) Gcomplex(&result, mag * cos(ang),
mag * sin(ang));
}
break;
BAD_DEFAULT
}
break;
case CMPLX:
switch (b.type) {
case INTGR:
if (a.v.cmplx_val.imag == 0.0) {
mag = pow(a.v.cmplx_val.real, (double) abs(b.v.int_val));
if (b.v.int_val < 0) {
if (mag != 0.0)
mag = 1.0 / mag;
else
undefined = TRUE;
}
(void) Gcomplex(&result, mag, 0.0);
} else {
/* not so good, but...! */
mag = pow(magnitude(&a), (double) abs(b.v.int_val));
if (b.v.int_val < 0) {
if (mag != 0.0)
mag = 1.0 / mag;
else
undefined = TRUE;
}
ang = angle(&a) * b.v.int_val;
(void) Gcomplex(&result, mag * cos(ang),
mag * sin(ang));
}
break;
case CMPLX:
if (a.v.cmplx_val.real == 0 && a.v.cmplx_val.imag == 0) {
if (b.v.cmplx_val.imag != 0 || b.v.cmplx_val.real < 0) {
undefined = TRUE;
}
/* return 1.0 for 0**0 */
Gcomplex(&result, b.v.cmplx_val.real == 0 ? 1.0 : 0.0, 0.0);
} else {
mag = pow(magnitude(&a), fabs(b.v.cmplx_val.real));
if (b.v.cmplx_val.real < 0.0) {
if (mag != 0.0)
mag = 1.0 / mag;
else
undefined = TRUE;
}
mag *= gp_exp(-b.v.cmplx_val.imag * angle(&a));
ang = b.v.cmplx_val.real * angle(&a) +
b.v.cmplx_val.imag * log(magnitude(&a));
(void) Gcomplex(&result, mag * cos(ang),
mag * sin(ang));
}
break;
BAD_DEFAULT
}
break;
BAD_DEFAULT
}
push(&result);
}
void f_factorial()
{
struct value a;
register int i;
register double val = 0.0;
(void) pop(&a); /* find a! (factorial) */
switch (a.type) {
case INTGR:
val = 1.0;
for (i = a.v.int_val; i > 1; i--) /*fpe's should catch overflows */
val *= i;
break;
default:
int_error("factorial (!) argument must be an integer", NO_CARET);
return; /* avoid gcc -Wall warning about val */
}
push(Gcomplex(&a, val, 0.0));
}
int f_jump(x)
union argument *x;
{
return (x->j_arg);
}
int f_jumpz(x)
union argument *x;
{
struct value a;
int_check(&top_of_stack);
if (top_of_stack.v.int_val) { /* non-zero */
(void) pop(&a);
return 1; /* no jump */
} else
return (x->j_arg); /* leave the argument on TOS */
}
int f_jumpnz(x)
union argument *x;
{
struct value a;
int_check(&top_of_stack);
if (top_of_stack.v.int_val) /* non-zero */
return (x->j_arg); /* leave the argument on TOS */
else {
(void) pop(&a);
return 1; /* no jump */
}
}
int f_jtern(x)
union argument *x;
{
struct value a;
int_check(pop(&a));
if (a.v.int_val)
return (1); /* no jump; fall through to TRUE code */
else
return (x->j_arg); /* go jump to FALSE code */
}