src/common/calfunc.c

#ifndef lint
static const char       RCSid[] = "$Id: calfunc.c,v 2.19 2019/03/04 18:16:18 greg Exp $";
#endif
/*
 *  calfunc.c - routines for calcomp using functions.
 *
 *      If VARIABLE is not set, only library functions
 *  can be accessed.
 *
 *  2/19/03     Eliminated conditional compiles in favor of esupport extern.
 */

#include "copyright.h"

#include  <stdio.h>
#include  <string.h>
#include  <errno.h>
#include  <math.h>

#include  "rterror.h"
#include  "calcomp.h"

                                /* bits in argument flag (better be right!) */
#define  AFLAGSIZ       (8*sizeof(unsigned long))
#define  ALISTSIZ       8       /* maximum saved argument list */

typedef struct activation {
    char  *name;                /* function name */
    struct activation  *prev;   /* previous activation */
    double  *ap;                /* argument list */
    unsigned long  an;          /* computed argument flags */
    EPNODE  *fun;               /* argument function */
}  ACTIVATION;          /* an activation record */

static ACTIVATION  *curact = NULL;

static double  libfunc(char *fname, VARDEF *vp);

#ifndef  MAXLIB
#define  MAXLIB         64      /* maximum number of library functions */
#endif

static double  l_if(char *), l_select(char *), l_rand(char *);
static double  l_floor(char *), l_ceil(char *);
static double  l_sqrt(char *);
static double  l_sin(char *), l_cos(char *), l_tan(char *);
static double  l_asin(char *), l_acos(char *), l_atan(char *), l_atan2(char *);
static double  l_exp(char *), l_log(char *), l_log10(char *);

                        /* functions must be listed alphabetically */
static LIBR  library[MAXLIB] = {
    { "acos", 1, ':', l_acos },
    { "asin", 1, ':', l_asin },
    { "atan", 1, ':', l_atan },
    { "atan2", 2, ':', l_atan2 },
    { "ceil", 1, ':', l_ceil },
    { "cos", 1, ':', l_cos },
    { "exp", 1, ':', l_exp },
    { "floor", 1, ':', l_floor },
    { "if", 3, ':', l_if },
    { "log", 1, ':', l_log },
    { "log10", 1, ':', l_log10 },
    { "rand", 1, ':', l_rand },
    { "select", 1, ':', l_select },
    { "sin", 1, ':', l_sin },
    { "sqrt", 1, ':', l_sqrt },
    { "tan", 1, ':', l_tan },
};

static int  libsize = 16;

#define  resolve(ep)    ((ep)->type==VAR?(ep)->v.ln:argf((ep)->v.chan))


int
fundefined(                     /* return # of arguments for function */
        char  *fname
)
{
    LIBR  *lp;
    VARDEF  *vp;

    if ((vp = varlookup(fname)) != NULL && vp->def != NULL
                && vp->def->v.kid->type == FUNC)
        return(nekids(vp->def->v.kid) - 1);
    lp = vp != NULL ? vp->lib : liblookup(fname);
    if (lp == NULL)
        return(0);
    return(lp->nargs);
}


double
funvalue(                       /* return a function value to the user */
        char  *fname,
        int  n,
        double  *a
)
{
    ACTIVATION  act;
    VARDEF  *vp;
    double  rval;
                                        /* push environment */
    act.name = fname;
    act.prev = curact;
    act.ap = a;
    if (n < AFLAGSIZ)
        act.an = (1L<<n)-1;
    else {
        act.an = ~0;
        if (n > AFLAGSIZ)
            wputs("Excess arguments in funvalue()\n");
    }
    act.fun = NULL;
    curact = &act;

    if ((vp = varlookup(fname)) == NULL || vp->def == NULL
                || vp->def->v.kid->type != FUNC)
        rval = libfunc(fname, vp);
    else
        rval = evalue(vp->def->v.kid->sibling);

    curact = act.prev;                  /* pop environment */
    return(rval);
}


void
funset(                         /* set a library function */
        char  *fname,
        int  nargs,
        int  assign,
        double  (*fptr)(char *)
)
{
    int  oldlibsize = libsize;
    char *cp;
    LIBR  *lp;
                                                /* check for context */
    for (cp = fname; *cp; cp++)
        ;
    if (cp == fname)
        return;
    if (cp[-1] == CNTXMARK)
        *--cp = '\0';
    if ((lp = liblookup(fname)) == NULL) {      /* insert */
        if (libsize >= MAXLIB) {
            eputs("Too many library functons!\n");
            quit(1);
        }
        for (lp = &library[libsize]; lp > library; lp--)
            if (strcmp(lp[-1].fname, fname) > 0)
                lp[0] = lp[-1];
            else
                break;
        libsize++;
    }
    if (fptr == NULL) {                         /* delete */
        while (lp < &library[libsize-1]) {
            lp[0] = lp[1];
            lp++;
        }
        libsize--;
    } else {                                    /* or assign */
        lp[0].fname = fname;            /* string must be static! */
        lp[0].nargs = nargs;
        lp[0].atyp = assign;
        lp[0].f = fptr;
    }
    if (libsize != oldlibsize)
        libupdate(fname);                       /* relink library */
}


int
nargum(void)                    /* return number of available arguments */
{
    int  n;

    if (curact == NULL)
        return(0);
    if (curact->fun == NULL) {
        for (n = 0; (1L<<n) & curact->an; n++)
            ;
        return(n);
    }
    return(nekids(curact->fun) - 1);
}


double
argument(int n)                 /* return nth argument for active function */
{
    ACTIVATION  *actp = curact;
    EPNODE  *ep = NULL;
    double  aval;

    if (!actp | (--n < 0)) {
        eputs("Bad call to argument!\n");
        quit(1);
    }
    if ((n < AFLAGSIZ) & actp->an >> n)         /* already computed? */
        return(actp->ap[n]);

    if (!actp->fun || !(ep = ekid(actp->fun, n+1))) {
        eputs(actp->name);
        eputs(": too few arguments\n");
        quit(1);
    }
    curact = actp->prev;                        /* previous context */
    aval = evalue(ep);                          /* compute argument */
    curact = actp;                              /* put back calling context */
    if (n < ALISTSIZ) {                         /* save value if room */
        actp->ap[n] = aval;
        actp->an |= 1L<<n;
    }
    return(aval);
}


VARDEF *
argf(int n)                     /* return function def for nth argument */
{
    ACTIVATION  *actp;
    EPNODE  *ep;

    for (actp = curact; actp != NULL; actp = actp->prev) {

        if (n <= 0)
            break;

        if (actp->fun == NULL)
            goto badarg;

        if ((ep = ekid(actp->fun, n)) == NULL) {
            eputs(actp->name);
            eputs(": too few arguments\n");
            quit(1);
        }
        if (ep->type == VAR)
            return(ep->v.ln);                   /* found it */

        if (ep->type != ARG)
            goto badarg;

        n = ep->v.chan;                         /* try previous context */
    }
    eputs("Bad call to argf!\n");
    quit(1);

badarg:
    eputs(actp->name);
    eputs(": argument not a function\n");
    quit(1);
        return NULL; /* pro forma return */
}


char *
argfun(int n)                   /* return function name for nth argument */
{
    return(argf(n)->name);
}


double
efunc(EPNODE *ep)                       /* evaluate a function */
{
    ACTIVATION  act;
    double  alist[ALISTSIZ];
    double  rval;
    VARDEF  *dp;
                                        /* push environment */
    dp = resolve(ep->v.kid);
    act.name = dp->name;
    act.prev = curact;
    act.ap = alist;
    act.an = 0;
    act.fun = ep;
    curact = &act;

    if (dp->def == NULL || dp->def->v.kid->type != FUNC)
        rval = libfunc(act.name, dp);
    else
        rval = evalue(dp->def->v.kid->sibling);
    
    curact = act.prev;                  /* pop environment */
    return(rval);
}


LIBR *
liblookup(char *fname)          /* look up a library function */
{
    int  upper, lower;
    int  cm, i;

    lower = 0;
    upper = cm = libsize;

    while ((i = (lower + upper) >> 1) != cm) {
        cm = strcmp(fname, library[i].fname);
        if (cm > 0)
            lower = i;
        else if (cm < 0)
            upper = i;
        else
            return(&library[i]);
        cm = i;
    }
    return(NULL);
}


/*
 *  The following routines are for internal use:
 */


static double
libfunc(                                /* execute library function */
        char  *fname,
        VARDEF  *vp
)
{
    LIBR  *lp;
    double  d;
    int  lasterrno;

    if (vp != NULL)
        lp = vp->lib;
    else
        lp = liblookup(fname);
    if (lp == NULL) {
        eputs(fname);
        eputs(": undefined function\n");
        quit(1);
    }
    lasterrno = errno;
    errno = 0;
    d = (*lp->f)(lp->fname);
#ifdef  isnan
    if (errno == 0) {
        if (isnan(d))
            errno = EDOM;
        else if (isinf(d))
            errno = ERANGE;
    }
#endif
    if (errno == EDOM || errno == ERANGE) {
        wputs(fname);
        if (errno == EDOM)
                wputs(": domain error\n");
        else if (errno == ERANGE)
                wputs(": range error\n");
        else
                wputs(": error in call\n");
        return(0.0);
    }
    errno = lasterrno;
    return(d);
}


/*
 *  Library functions:
 */


static double
l_if(char *nm)          /* if(cond, then, else) conditional expression */
                        /* cond evaluates true if greater than zero */
{
    if (argument(1) > 0.0)
        return(argument(2));
    else
        return(argument(3));
}


static double
l_select(char *nm)      /* return argument #(A1+1) */
{
        int  n;

        n = (int)(argument(1) + .5);
        if (n == 0)
                return(nargum()-1);
        if (n < 1 || n > nargum()-1) {
                errno = EDOM;
                return(0.0);
        }
        return(argument(n+1));
}


static double
l_rand(char *nm)                /* random function between 0 and 1 */
{
    double  x;

    x = argument(1);
    x *= 1.0/(1.0 + x*x) + 2.71828182845904;
    x += .785398163397447 - floor(x);
    x = 1e5 / x;
    return(x - floor(x));
}


static double
l_floor(char *nm)               /* return largest integer not greater than arg1 */
{
    return(floor(argument(1)));
}


static double
l_ceil(char *nm)                /* return smallest integer not less than arg1 */
{
    return(ceil(argument(1)));
}


static double
l_sqrt(char *nm)
{
    return(sqrt(argument(1)));
}


static double
l_sin(char *nm)
{
    return(sin(argument(1)));
}


static double
l_cos(char *nm)
{
    return(cos(argument(1)));
}


static double
l_tan(char *nm)
{
    return(tan(argument(1)));
}


static double
l_asin(char *nm)
{
    return(asin(argument(1)));
}


static double
l_acos(char *nm)
{
    return(acos(argument(1)));
}


static double
l_atan(char *nm)
{
    return(atan(argument(1)));
}


static double
l_atan2(char *nm)
{
    return(atan2(argument(1), argument(2)));
}


static double
l_exp(char *nm)
{
    return(exp(argument(1)));
}


static double
l_log(char *nm)
{
    return(log(argument(1)));
}


static double
l_log10(char *nm)
{
    return(log10(argument(1)));
}
Revision:	2.20
Committed:	Mon Mar 4 20:34:13 2019 UTC (6 years, 7 months ago) by greg
Content type:	text/plain
Branch:	MAIN
Changes since 2.19:	+4 -4 lines
Log Message:	Removed parentheses for clarity(?)
#	User	Rev	Content
1	greg	1.1	#ifndef lint
2	greg	2.20	static const char RCSid[] = "$Id: calfunc.c,v 2.19 2019/03/04 18:16:18 greg Exp $";
3	greg	1.1	#endif
4			/*
5			* calfunc.c - routines for calcomp using functions.
6			*
7	greg	2.8	* If VARIABLE is not set, only library functions
8			* can be accessed.
9			*
10			* 2/19/03 Eliminated conditional compiles in favor of esupport extern.
11			*/
12
13	greg	2.9	#include "copyright.h"
14	greg	1.1
15			#include <stdio.h>
16	schorsch	2.11	#include <string.h>
17	greg	1.1	#include <errno.h>
18	greg	2.5	#include <math.h>
19
20	schorsch	2.12	#include "rterror.h"
21	greg	1.1	#include "calcomp.h"
22
23	greg	1.5	/* bits in argument flag (better be right!) */
24			#define AFLAGSIZ (8*sizeof(unsigned long))
25	greg	2.19	#define ALISTSIZ 8 /* maximum saved argument list */
26	greg	1.1
27			typedef struct activation {
28			char name; / function name */
29			struct activation prev; / previous activation */
30			double ap; / argument list */
31			unsigned long an; /* computed argument flags */
32			EPNODE fun; / argument function */
33			} ACTIVATION; /* an activation record */
34
35			static ACTIVATION *curact = NULL;
36
37	schorsch	2.12	static double libfunc(char fname, VARDEF vp);
38	greg	1.1
39	greg	2.8	#ifndef MAXLIB
40	greg	1.1	#define MAXLIB 64 /* maximum number of library functions */
41	greg	2.8	#endif
42	greg	1.1
43	greg	2.13	static double l_if(char ), l_select(char ), l_rand(char *);
44			static double l_floor(char ), l_ceil(char );
45			static double l_sqrt(char *);
46			static double l_sin(char ), l_cos(char ), l_tan(char *);
47			static double l_asin(char ), l_acos(char ), l_atan(char ), l_atan2(char );
48			static double l_exp(char ), l_log(char ), l_log10(char *);
49	greg	1.1
50			/* functions must be listed alphabetically */
51			static LIBR library[MAXLIB] = {
52	greg	1.4	{ "acos", 1, ':', l_acos },
53			{ "asin", 1, ':', l_asin },
54			{ "atan", 1, ':', l_atan },
55			{ "atan2", 2, ':', l_atan2 },
56			{ "ceil", 1, ':', l_ceil },
57			{ "cos", 1, ':', l_cos },
58			{ "exp", 1, ':', l_exp },
59			{ "floor", 1, ':', l_floor },
60			{ "if", 3, ':', l_if },
61			{ "log", 1, ':', l_log },
62			{ "log10", 1, ':', l_log10 },
63			{ "rand", 1, ':', l_rand },
64			{ "select", 1, ':', l_select },
65			{ "sin", 1, ':', l_sin },
66			{ "sqrt", 1, ':', l_sqrt },
67			{ "tan", 1, ':', l_tan },
68	greg	1.1	};
69
70			static int libsize = 16;
71
72			#define resolve(ep) ((ep)->type==VAR?(ep)->v.ln:argf((ep)->v.chan))
73
74
75			int
76	greg	2.16	fundefined( /* return # of arguments for function */
77			char *fname
78			)
79	greg	1.1	{
80	greg	2.16	LIBR *lp;
81			VARDEF *vp;
82	greg	1.1
83	greg	2.7	if ((vp = varlookup(fname)) != NULL && vp->def != NULL
84			&& vp->def->v.kid->type == FUNC)
85	greg	1.1	return(nekids(vp->def->v.kid) - 1);
86	greg	2.7	lp = vp != NULL ? vp->lib : liblookup(fname);
87			if (lp == NULL)
88			return(0);
89			return(lp->nargs);
90	greg	1.1	}
91
92
93			double
94	greg	2.16	funvalue( /* return a function value to the user */
95			char *fname,
96			int n,
97			double *a
98			)
99	greg	1.1	{
100			ACTIVATION act;
101	greg	2.16	VARDEF *vp;
102	greg	1.1	double rval;
103			/* push environment */
104			act.name = fname;
105			act.prev = curact;
106			act.ap = a;
107	greg	2.19	if (n < AFLAGSIZ)
108			act.an = (1L<<n)-1;
109			else {
110	greg	1.5	act.an = ~0;
111	greg	2.19	if (n > AFLAGSIZ)
112			wputs("Excess arguments in funvalue()\n");
113			}
114	greg	1.1	act.fun = NULL;
115			curact = &act;
116
117			if ((vp = varlookup(fname)) == NULL \|\| vp->def == NULL
118			\|\| vp->def->v.kid->type != FUNC)
119			rval = libfunc(fname, vp);
120			else
121			rval = evalue(vp->def->v.kid->sibling);
122
123			curact = act.prev; /* pop environment */
124			return(rval);
125			}
126
127
128	greg	2.8	void
129	greg	2.16	funset( /* set a library function */
130			char *fname,
131			int nargs,
132			int assign,
133			double (fptr)(char )
134			)
135	greg	1.1	{
136	greg	2.6	int oldlibsize = libsize;
137	greg	2.8	char *cp;
138	greg	2.16	LIBR *lp;
139	greg	2.8	/* check for context */
140			for (cp = fname; *cp; cp++)
141			;
142			if (cp == fname)
143			return;
144			if (cp[-1] == CNTXMARK)
145			*--cp = '\0';
146	greg	2.2	if ((lp = liblookup(fname)) == NULL) { /* insert */
147	greg	1.1	if (libsize >= MAXLIB) {
148			eputs("Too many library functons!\n");
149			quit(1);
150			}
151			for (lp = &library[libsize]; lp > library; lp--)
152	greg	2.17	if (strcmp(lp[-1].fname, fname) > 0)
153			lp[0] = lp[-1];
154			else
155	greg	1.1	break;
156			libsize++;
157			}
158	greg	2.2	if (fptr == NULL) { /* delete */
159			while (lp < &library[libsize-1]) {
160	greg	2.17	lp[0] = lp[1];
161	greg	2.2	lp++;
162			}
163			libsize--;
164			} else { /* or assign */
165			lp[0].fname = fname; /* string must be static! */
166			lp[0].nargs = nargs;
167			lp[0].atyp = assign;
168			lp[0].f = fptr;
169			}
170	greg	2.6	if (libsize != oldlibsize)
171			libupdate(fname); /* relink library */
172	greg	1.1	}
173
174
175			int
176	greg	2.16	nargum(void) /* return number of available arguments */
177	greg	1.1	{
178	greg	2.16	int n;
179	greg	1.1
180			if (curact == NULL)
181			return(0);
182			if (curact->fun == NULL) {
183			for (n = 0; (1L<<n) & curact->an; n++)
184			;
185			return(n);
186			}
187			return(nekids(curact->fun) - 1);
188			}
189
190
191			double
192	greg	2.16	argument(int n) /* return nth argument for active function */
193	greg	1.1	{
194	greg	2.16	ACTIVATION *actp = curact;
195			EPNODE *ep = NULL;
196	greg	1.1	double aval;
197
198	greg	2.19	if (!actp \| (--n < 0)) {
199	greg	1.1	eputs("Bad call to argument!\n");
200			quit(1);
201			}
202	greg	2.20	if ((n < AFLAGSIZ) & actp->an >> n) /* already computed? */
203	greg	1.1	return(actp->ap[n]);
204
205	greg	2.19	if (!actp->fun \|\| !(ep = ekid(actp->fun, n+1))) {
206	greg	1.1	eputs(actp->name);
207			eputs(": too few arguments\n");
208			quit(1);
209			}
210	greg	2.19	curact = actp->prev; /* previous context */
211	greg	1.1	aval = evalue(ep); /* compute argument */
212	greg	2.20	curact = actp; /* put back calling context */
213			if (n < ALISTSIZ) { /* save value if room */
214	greg	1.1	actp->ap[n] = aval;
215			actp->an \|= 1L<<n;
216			}
217			return(aval);
218			}
219
220
221			VARDEF *
222	greg	2.16	argf(int n) /* return function def for nth argument */
223	greg	1.1	{
224	greg	2.16	ACTIVATION *actp;
225			EPNODE *ep;
226	greg	1.1
227			for (actp = curact; actp != NULL; actp = actp->prev) {
228
229			if (n <= 0)
230			break;
231
232			if (actp->fun == NULL)
233			goto badarg;
234
235			if ((ep = ekid(actp->fun, n)) == NULL) {
236			eputs(actp->name);
237			eputs(": too few arguments\n");
238			quit(1);
239			}
240			if (ep->type == VAR)
241			return(ep->v.ln); /* found it */
242
243			if (ep->type != ARG)
244			goto badarg;
245
246			n = ep->v.chan; /* try previous context */
247			}
248			eputs("Bad call to argf!\n");
249			quit(1);
250
251			badarg:
252			eputs(actp->name);
253			eputs(": argument not a function\n");
254			quit(1);
255	schorsch	2.11	return NULL; /* pro forma return */
256	greg	1.1	}
257
258
259			char *
260	greg	2.16	argfun(int n) /* return function name for nth argument */
261	greg	1.1	{
262			return(argf(n)->name);
263			}
264
265
266			double
267	greg	2.16	efunc(EPNODE ep) / evaluate a function */
268	greg	1.1	{
269			ACTIVATION act;
270			double alist[ALISTSIZ];
271			double rval;
272	greg	2.16	VARDEF *dp;
273	greg	1.1	/* push environment */
274			dp = resolve(ep->v.kid);
275			act.name = dp->name;
276			act.prev = curact;
277			act.ap = alist;
278			act.an = 0;
279			act.fun = ep;
280			curact = &act;
281
282			if (dp->def == NULL \|\| dp->def->v.kid->type != FUNC)
283			rval = libfunc(act.name, dp);
284			else
285			rval = evalue(dp->def->v.kid->sibling);
286
287			curact = act.prev; /* pop environment */
288			return(rval);
289			}
290
291
292			LIBR *
293	greg	2.16	liblookup(char fname) / look up a library function */
294	greg	1.1	{
295			int upper, lower;
296	greg	2.16	int cm, i;
297	greg	1.1
298			lower = 0;
299			upper = cm = libsize;
300
301			while ((i = (lower + upper) >> 1) != cm) {
302			cm = strcmp(fname, library[i].fname);
303			if (cm > 0)
304			lower = i;
305			else if (cm < 0)
306			upper = i;
307			else
308			return(&library[i]);
309			cm = i;
310			}
311			return(NULL);
312			}
313
314
315			/*
316			* The following routines are for internal use:
317			*/
318
319
320			static double
321	greg	2.16	libfunc( /* execute library function */
322			char *fname,
323			VARDEF *vp
324			)
325	greg	1.1	{
326	greg	2.16	LIBR *lp;
327	greg	1.1	double d;
328			int lasterrno;
329
330	greg	2.3	if (vp != NULL)
331			lp = vp->lib;
332			else
333			lp = liblookup(fname);
334			if (lp == NULL) {
335	greg	1.1	eputs(fname);
336			eputs(": undefined function\n");
337			quit(1);
338			}
339			lasterrno = errno;
340			errno = 0;
341	greg	2.3	d = (*lp->f)(lp->fname);
342	greg	2.15	#ifdef isnan
343	greg	2.18	if (errno == 0) {
344	greg	1.9	if (isnan(d))
345			errno = EDOM;
346			else if (isinf(d))
347			errno = ERANGE;
348	greg	2.18	}
349	greg	1.1	#endif
350	greg	2.10	if (errno == EDOM \|\| errno == ERANGE) {
351	greg	1.1	wputs(fname);
352	greg	1.8	if (errno == EDOM)
353			wputs(": domain error\n");
354			else if (errno == ERANGE)
355			wputs(": range error\n");
356			else
357			wputs(": error in call\n");
358	greg	1.1	return(0.0);
359			}
360			errno = lasterrno;
361			return(d);
362			}
363
364
365			/*
366			* Library functions:
367			*/
368
369
370			static double
371	greg	2.13	l_if(char nm) / if(cond, then, else) conditional expression */
372	greg	1.1	/* cond evaluates true if greater than zero */
373			{
374			if (argument(1) > 0.0)
375			return(argument(2));
376			else
377			return(argument(3));
378			}
379
380
381			static double
382	greg	2.13	l_select(char nm) / return argument #(A1+1) */
383	greg	1.1	{
384	greg	2.16	int n;
385	greg	1.1
386	schorsch	2.11	n = (int)(argument(1) + .5);
387	greg	1.1	if (n == 0)
388			return(nargum()-1);
389			if (n < 1 \|\| n > nargum()-1) {
390			errno = EDOM;
391			return(0.0);
392			}
393			return(argument(n+1));
394			}
395
396
397			static double
398	greg	2.13	l_rand(char nm) / random function between 0 and 1 */
399	greg	1.1	{
400			double x;
401
402			x = argument(1);
403			x = 1.0/(1.0 + xx) + 2.71828182845904;
404			x += .785398163397447 - floor(x);
405			x = 1e5 / x;
406			return(x - floor(x));
407			}
408
409
410			static double
411	greg	2.13	l_floor(char nm) / return largest integer not greater than arg1 */
412	greg	1.1	{
413			return(floor(argument(1)));
414			}
415
416
417			static double
418	greg	2.13	l_ceil(char nm) / return smallest integer not less than arg1 */
419	greg	1.1	{
420			return(ceil(argument(1)));
421			}
422
423
424			static double
425	greg	2.13	l_sqrt(char *nm)
426	greg	1.1	{
427			return(sqrt(argument(1)));
428			}
429
430
431			static double
432	greg	2.13	l_sin(char *nm)
433	greg	1.1	{
434			return(sin(argument(1)));
435			}
436
437
438			static double
439	greg	2.13	l_cos(char *nm)
440	greg	1.1	{
441			return(cos(argument(1)));
442			}
443
444
445			static double
446	greg	2.13	l_tan(char *nm)
447	greg	1.1	{
448			return(tan(argument(1)));
449			}
450
451
452			static double
453	greg	2.13	l_asin(char *nm)
454	greg	1.1	{
455			return(asin(argument(1)));
456			}
457
458
459			static double
460	greg	2.13	l_acos(char *nm)
461	greg	1.1	{
462			return(acos(argument(1)));
463			}
464
465
466			static double
467	greg	2.13	l_atan(char *nm)
468	greg	1.1	{
469			return(atan(argument(1)));
470			}
471
472
473			static double
474	greg	2.13	l_atan2(char *nm)
475	greg	1.1	{
476			return(atan2(argument(1), argument(2)));
477			}
478
479
480			static double
481	greg	2.13	l_exp(char *nm)
482	greg	1.1	{
483			return(exp(argument(1)));
484			}
485
486
487			static double
488	greg	2.13	l_log(char *nm)
489	greg	1.1	{
490			return(log(argument(1)));
491			}
492
493
494			static double
495	greg	2.13	l_log10(char *nm)
496	greg	1.1	{
497			return(log10(argument(1)));
498			}