diff --git a/psys/include/p2c/numex.h b/psys/include/p2c/numex.h
deleted file mode 100644
index 8c5afb0a687ecefccb9db39ee7a604d008577172..0000000000000000000000000000000000000000
--- a/psys/include/p2c/numex.h
+++ /dev/null
@@ -1,220 +0,0 @@
-#ifndef NUMEX_H
-#define NUMEX_H
-
-
-#include <p2c/strlist.h>
-#include <p2c/newasm.h>
-
-#ifdef NUMEX_G
-# define vextern
-#else
-# define vextern extern
-#endif
-
-
-#define ne_maxargs 255
-
-#define ne_badvalue 1.2345678e277 /*not likely to occur in nature*/
-
-#define ne_badescape (-50)
-
-
-
-typedef enum {
- ne_notype, ne_integer, ne_real, ne_string, ne_boolean
-} ne_datatype;
-typedef ne_datatype ne_datatypearray[ne_maxargs];
-
-typedef enum {
- ne_error, ne_ic, ne_rc, ne_sc, ne_ip, ne_rp, ne_sp, ne_if, ne_rf, ne_sf,
- ne_iarg, ne_rarg, ne_sarg, ne_iadd, ne_isub, ne_imul, ne_idiv, ne_ineg,
- ne_radd, ne_rsub, ne_rmul, ne_rdiv, ne_rneg, ne_rpow, ne_sadd, ne_itor,
- ne_imod, ne_rbool, ne_sbool, ne_ieq, ne_ine, ne_ilt, ne_ile, ne_igt, ne_ige,
- ne_req, ne_rne, ne_rlt, ne_rle, ne_rgt, ne_rge, ne_seq, ne_sne, ne_slt,
- ne_sle, ne_sgt, ne_sge, ne_not, ne_and, ne_or, ne_xor, ne_lsh, ne_rsh,
- ne_lnot, ne_ior, ne_ror, ne_sor, ne_iand, ne_rand, ne_sand, ne_icond,
- ne_rcond, ne_scond, ne_round, ne_trunc, ne_ln, ne_exp, ne_iabs, ne_rabs,
- ne_sqrt, ne_sin, ne_cos, ne_tan, ne_arctan, ne_rxp, ne_rxor
-} ne_opkind;
-
-
-typedef enum {
- ne_noerror, ne_syntax, ne_overflow, ne_underflow, ne_divzero, ne_strlong,
- ne_badtypes, ne_undef, ne_badval
-} ne_errorkind;
-
-
-
-
-typedef struct ne_functionrec {
- uchar nargs, minargs, maxargs;
- unsigned static_ : 1, subnex : 1, dummy_2 : 6;
- union {
- na_quadword qw;
- struct ne_nexrec **nexp;
- struct {
- _PROCEDURE ipr;
- unsigned arg1 : 3, arg2 : 3, arg3 : 3, arg4 : 3;
- } U5;
- _PROCEDURE rpr;
- _PROCEDURE spr;
- struct {
- na_quadword qw2;
- ne_datatype ptypes[ne_maxargs];
- } U99;
- } UU;
-} ne_functionrec;
-
-typedef struct ne_nexrec *ne_nexptrarray[ne_maxargs];
-
-typedef na_quadword ne_argvalarray[ne_maxargs];
-
-typedef struct ne_nexrec {
- uchar nargs;
- unsigned op : 7;
- union {
- na_quadword qw;
- unsigned err : 4;
- long i;
- double r;
- char *s;
- struct {
- long *ip;
- strlist_t *ips;
- struct ne_nexrec *p1, *p2, *p3, *p4;
- } U10;
- struct {
- double *rp;
- strlist_t *rps;
- } U11;
- struct {
- char **sp;
- strlist_t *sps;
- } U12;
- struct {
- ne_functionrec *fp;
- strlist_t *fps;
- } U15;
- struct {
- struct ne_nexrec **ep;
- strlist_t *eps;
- } U16;
- struct {
- na_quadword qw2;
- ne_nexptrarray pvals;
- } U99;
- } UU;
-} ne_nexrec;
-
-
-typedef struct ne_desc {
- strlist_t *symtab;
- unsigned casesens : 1, builtin : 1, scaled : 1, doubleeq : 1, isfunc : 1,
- dummy0 : 7, error : 4;
- char units[6];
- long startident[9], ident[9]; /*must not contain #0*/
- _PROCEDURE symproc;
- na_long dummy1, dummy2;
-} ne_desc;
-
-
-#define ne_kind_intconst 'A' /*for symbol table entries*/
-#define ne_kind_intvalue 'B'
-#define ne_kind_intptr 'C'
-#define ne_kind_intfunc 'D'
-#define ne_kind_realconst 'E'
-#define ne_kind_srealconst 'F'
-#define ne_kind_realptr 'G'
-#define ne_kind_realfunc 'H'
-#define ne_kind_strconst 'I'
-#define ne_kind_strvalue 'J'
-#define ne_kind_strptr 'K'
-#define ne_kind_strfunc 'L'
-#define ne_kind_intarg 'M'
-#define ne_kind_realarg 'N'
-#define ne_kind_strarg 'O'
-#define ne_kind_realxptr 'P'
-#define ne_kind_nex 'Z'
-
-
-vextern na_quadword *ne_argarray;
-
-
-extern void ne_init (ne_desc *desc);
-extern void ne_compile (char *ex, ne_nexrec **nex, ne_desc *desc);
-extern void ne_intcompile (char *ex, long *endp, ne_nexrec **nex,
- ne_desc *desc);
-extern void ne_dump (ne_nexrec *nex);
-extern void ne_uncompile (ne_nexrec *nex, char *ex, ne_desc *desc);
-extern void ne_copy (ne_nexrec *nex, ne_nexrec **newnex);
-extern void ne_dispose (ne_nexrec **nex);
-extern void ne_constant (ne_nexrec **nex, ne_desc *desc, char *which);
-extern void ne_notconstant (ne_nexrec **nex, ne_desc *desc, char *which);
-extern void ne_constantlist (ne_nexrec **nex, ne_desc *desc,
- strlist_t *which);
-extern void ne_notconstantlist (ne_nexrec **nex, ne_desc *desc,
- strlist_t *which);
-extern ne_nexrec *ne_makeerror (ne_errorkind err);
-extern ne_datatype ne_exprtype (ne_nexrec *nex);
-extern ne_nexrec *ne_typecast (ne_nexrec *nex, ne_datatype typ);
-extern void ne_evaluate (ne_nexrec *nex, ne_nexrec *res);
-extern long ne_ievaluate (ne_nexrec *nex, ne_desc *desc);
-extern double ne_revaluate (ne_nexrec *nex, ne_desc *desc);
-extern char *ne_sevaluate (char *Result, ne_nexrec *nex, ne_desc *desc);
-extern long ne_ievalexpr (char *ex, ne_desc *desc);
-extern double ne_revalexpr (char *ex, ne_desc *desc);
-
-extern char *ne_sevalexpr (char *Result, char *ex, ne_desc *desc);
-extern void ne_makeintconst (strlist_t *sym, long i);
-extern void ne_makesrealconst (strlist_t *sym, double r);
-extern void ne_makerealconst (strlist_t *sym, double r);
-extern void ne_makestrconst (strlist_t *sym, char *s);
-extern void ne_makeintvar (strlist_t *sym, long *i);
-extern void ne_makerealvar (strlist_t *sym, double *r);
-extern void ne_makerealxvar (strlist_t *sym, double *r);
-extern void ne_makestrvar (strlist_t *sym, char *s);
-extern void ne_makestrptrvar (strlist_t *sym, char **sp);
-extern void ne_makeintfunc (strlist_t *sym, ne_datatype t1,
- ne_datatype t2, ne_datatype t3,
- _PROCEDURE pr);
-extern void ne_makerealfunc (strlist_t *sym, ne_datatype t1,
- ne_datatype t2, ne_datatype t3,
- _PROCEDURE pr);
-extern void ne_makestrfunc (strlist_t *sym, ne_datatype t1,
- ne_datatype t2, ne_datatype t3,
- _PROCEDURE pr);
-extern void ne_makeintmfunc (strlist_t *sym, long nargs,
- ne_datatype *args, _PROCEDURE pr);
-extern void ne_makerealmfunc (strlist_t *sym, long nargs,
- ne_datatype *args, _PROCEDURE pr);
-extern void ne_makestrmfunc (strlist_t *sym, long nargs,
- ne_datatype *args, _PROCEDURE pr);
-extern void ne_makeintsfunc (strlist_t *sym, long nargs,
- ne_datatype *args, ne_nexrec **nex);
-extern void ne_makerealsfunc (strlist_t *sym, long nargs,
- ne_datatype *args, ne_nexrec **nex);
-extern void ne_makestrsfunc (strlist_t *sym, long nargs,
- ne_datatype *args, ne_nexrec **nex);
-extern void ne_makeintarg (strlist_t *sym, long i);
-extern void ne_makerealarg (strlist_t *sym, long i);
-extern void ne_makestrarg (strlist_t *sym, long i);
-extern void ne_setminargs (strlist_t *sym, long minargs);
-extern void ne_setmaxargs (strlist_t *sym, long maxargs);
-extern void ne_makestaticfunc (strlist_t *sym);
-extern void ne_disposesym (strlist_t *sym);
-
-extern void ne_disposesymtab (strlist_t **symtab);
-extern int ne_condeval (ne_nexrec *nex);
-extern long ne_ieval (ne_nexrec *nex);
-extern double ne_reval (ne_nexrec *nex);
-
-extern char *ne_seval (char *Result, ne_nexrec *nex);
-
-extern int ne_readreal (char *s, double *r, ne_desc *desc);
-
-
-#undef vextern
-
-#endif /*NUMEX_H*/
-
-/* End. */
diff --git a/psys/src/Makefile b/psys/src/Makefile
index df447ed2bd419e23648b2e1f406e3652276a21ed..94a60d7ce778454a82d6486fd9769c48c53badfd 100644
--- a/psys/src/Makefile
+++ b/psys/src/Makefile
@@ -104,7 +104,6 @@ OBJS = sysdevs.o \
math.o \
rnd.o \
regex.o \
- numex.o \
p2clib.o \
loc.p2clib.o
@@ -238,7 +237,6 @@ psysinc:
cp ../include/p2c/newasm.h psys/include/p2c
cp ../include/p2c/newcrt.h psys/include/p2c
cp ../include/p2c/regex.h psys/include/p2c
- cp ../include/p2c/numex.h psys/include/p2c
cp ../include/p2c/plot.h psys/include/p2c
cp ../include/p2c/plot_routines.h psys/include/p2c
cp ../include/p2c/rnd.h psys/include/p2c
@@ -260,7 +258,6 @@ psyssrc:
cp newci.c psys/src
cp newcrt.c psys/src
cp newkbd.c psys/src
- cp numex.c psys/src
cp p2clib.c psys/src
cp plot.c psys/src
cp plot.font psys/src
diff --git a/psys/src/numex.c b/psys/src/numex.c
deleted file mode 100644
index 5825bced96cd1da8b97db9f27f1552fd6413d684..0000000000000000000000000000000000000000
--- a/psys/src/numex.c
+++ /dev/null
@@ -1,3412 +0,0 @@
-#include <p2c/p2c.h>
-#include <string.h>
-
-#define NUMEX_G
-#include <p2c/numex.h>
-#include <p2c/math.h>
-#include <p2c/strings.h>
-
-
-typedef ne_datatype typetab[76];
-
-
-static const typetab types =
-{
- ne_notype, ne_integer, ne_real, ne_string, ne_integer, ne_real, ne_string,
- ne_integer, ne_real, ne_string, ne_integer, ne_real, ne_string, ne_integer,
- ne_integer, ne_integer, ne_integer, ne_integer, ne_real, ne_real, ne_real,
- ne_real, ne_real, ne_real, ne_string, ne_real, ne_integer, ne_integer,
- ne_integer, ne_integer, ne_integer, ne_integer, ne_integer, ne_integer,
- ne_integer, ne_integer, ne_integer, ne_integer, ne_integer, ne_integer,
- ne_integer, ne_integer, ne_integer, ne_integer, ne_integer, ne_integer,
- ne_integer, ne_integer, ne_integer, ne_integer, ne_integer, ne_integer,
- ne_integer, ne_integer, ne_integer, ne_real, ne_string, ne_integer, ne_real,
- ne_string, ne_integer, ne_real, ne_string, ne_integer, ne_integer, ne_real,
- ne_real, ne_integer, ne_real, ne_real, ne_real, ne_real, ne_real, ne_real,
- ne_real, ne_real
-};
-
-
-#define numbuiltins 11
-
-
-typedef struct builtinrec
-{
- char name[9];
- char kind;
- ne_opkind op;
-} builtinrec;
-
-typedef builtinrec builtintab[numbuiltins];
-
-static builtintab builtins;
-
-
-#define numopersyms 22
-
-
-typedef struct opersymrec
-{
- char name;
- uchar lprec, rprec;
- unsigned iop : 7, rop : 7, sop : 7;
-} opersymrec;
-
-typedef opersymrec opersymtab[numopersyms];
-
-
-static const opersymtab opers =
-{
- { '?', 30, 29, ne_icond, ne_rcond, ne_scond },
- { '\b', 40, 40, ne_error, ne_rxor, ne_error },
- { '\005', 40, 40, ne_ior, ne_ror, ne_sor },
- { '\004', 50, 50, ne_iand, ne_rand, ne_sand },
- { '|', 60, 60, ne_or, ne_error, ne_error },
- { '@', 70, 70, ne_xor, ne_error, ne_error },
- { '&', 80, 80, ne_and, ne_error, ne_error },
- { '=', 90, 90, ne_ieq, ne_req, ne_seq },
- { '\001', 90, 90, ne_ine, ne_rne, ne_sne },
- { '<', 100, 100, ne_ilt, ne_rlt, ne_slt },
- { '>', 100, 100, ne_igt, ne_rgt, ne_sgt },
- { '\002', 100, 100, ne_ile, ne_rle, ne_sle },
- { '\003', 100, 100, ne_ige, ne_rge, ne_sge },
- { '\006', 110, 110, ne_lsh, ne_error, ne_error },
- { '\007', 110, 110, ne_rsh, ne_error, ne_error },
- { '+', 120, 120, ne_iadd, ne_radd, ne_sadd },
- { '-', 120, 120, ne_isub, ne_rsub, ne_error },
- { '*', 130, 130, ne_imul, ne_rmul, ne_error },
- { '/', 130, 130, ne_error, ne_rdiv, ne_error },
- { '\\', 130, 130, ne_idiv, ne_error, ne_error },
- { '%', 130, 130, ne_imod, ne_error, ne_error },
- { '^', 135, 134, ne_error, ne_rpow, ne_error }
-};
-
-#define neg_prec 140
-#define not_prec 140
-#define lnot_prec 140
-
-
-static int readreal(char *s, long *i, double *r, ne_desc *desc)
-{
- int Result;
- long j;
- char ch;
- char buf[256];
- char *STR1;
- char STR2[256];
-
- while (s[*i - 1] == ' ')
- (*i)++;
- j = *i;
-
- if (s[*i - 1] == '-' || s[*i - 1] == '+')
- (*i)++;
-
- while (isdigit(s[*i - 1]))
- (*i)++;
-
- if (s[*i - 1] == '.' && isdigit(s[*i]))
- {
- do {
- (*i)++;
- } while (isdigit(s[*i - 1]));
- }
-
- if ((s[*i - 1] == 'E' || s[*i - 1] == 'e') && ((isdigit(s[*i]) || (s[*i] == '-' || s[*i] == '+')) && isdigit(s[*i + 1])))
- {
- (*i)++;
- if (s[*i - 1] == '-' || s[*i - 1] == '+')
- (*i)++;
- while (isdigit(s[*i - 1]))
- (*i)++;
- }
-
- if (*i <= j)
- return false;
-
- buf[*i - j] = '\0';
- memmove((void*)buf, (void*)(&s[j - 1]), *i - j);
- *r = strtod(buf, &STR1);
- j = STR1 - buf + 1;
- Result = true;
- if (!P_inset(s[*i - 1], desc->startident))
- return Result;
- *buf = '\0';
- while (P_inset(s[*i - 1], desc->ident) || P_inset(s[*i - 1], desc->startident))
- {
- sprintf(buf + strlen(buf), "%c", s[*i - 1]);
- (*i)++;
- }
-
- strupper(buf, buf);
- if (strends(buf, strupper(STR2, desc->units)))
- {
- buf[strlen(buf) - strlen(desc->units)] = '\0';
- }
-
- if (*buf == '\0')
- return Result;
- ch = buf[0];
-
- switch (ch) {
- case 'F':
- *r *= 1e-15;
- return Result;
-
- case 'P':
- *r *= 1e-12;
- return Result;
-
- case 'N':
- *r *= 1e-9;
- return Result;
-
- case 'U':
- *r *= 1e-6;
- return Result;
-
- case 'K':
- *r *= 1e3;
- return Result;
-
- case 'G':
- *r *= 1e9;
- return Result;
-
- case 'T':
- *r *= 1e12;
- return Result;
-
- case 'M':
- return Result;
- }
-
- if (buf[1] == 'E' && buf[2] == 'G')
- *r *= 1e6;
- else
- *r *= 1e-3;
-
- return Result;
-}
-
-int ne_readreal(char *s_, double *r, ne_desc *desc)
-{
- char s[256];
- long i;
- char STR1[256];
-
- strcpy(s, s_);
- strcpy(STR1, s);
- strcpy(s, STR1);
- i = 1;
- return (readreal(s, &i, r, desc));
-}
-
-static char *realunit(char *Result, double r, char *u)
-{
- char s[256];
- char STR2[256];
-
- if (r == 0 || fabs(r) >= 1e15 || fabs(r) < 1e-16)
- {
- *s = '\0';
- }
- else if (fabs(r) >= 1e12)
- {
- strcpy(s, "T");
- r /= 1e12;
- }
- else if (fabs(r) >= 1e9)
- {
- strcpy(s, "G");
- r /= 1e9;
- }
- else if (fabs(r) >= 1e6)
- {
- strcpy(s, "Meg");
- r /= 1e6;
- }
- else if (fabs(r) >= 1e3)
- {
- strcpy(s, "K");
- r /= 1e3;
- }
- else if (fabs(r) >= 0.1)
- {
- *s = '\0';
- }
- else if (fabs(r) >= 1e-3)
- {
- strcpy(s, "m");
- r *= 1e3;
- }
- else if (fabs(r) >= 1e-6)
- {
- strcpy(s, "u");
- r *= 1e6;
- }
- else if (fabs(r) >= 1e-9)
- {
- strcpy(s, "n");
- r *= 1e9;
- }
- else if (fabs(r) >= 1e-12)
- {
- strcpy(s, "p");
- r *= 1e12;
- }
- else
- {
- strcpy(s, "f");
- r *= 1e15;
- }
-
- sprintf(s, "%g%s", r, strcpy(STR2, s));
- sprintf(Result, "%s%s", s, u);
- return Result;
-}
-
-
-static void dummysymproc(char *name, ne_desc *desc, strlist_t **symptr)
-{
- *symptr = strlist_find(desc->symtab, name);
-}
-
-void ne_init(ne_desc *desc)
-{
- strcpy(builtins[0].name,"ROUND");
- builtins[0].kind = 'A';
- builtins[0].op = ne_error;
- strcpy(builtins[1].name,"TRUNC");
- builtins[1].kind = 'A';
- builtins[1].op = ne_error;
- strcpy(builtins[2].name,"LN");
- builtins[2].kind = 'B';
- builtins[2].op = ne_error;
- strcpy(builtins[3].name,"EXP");
- builtins[3].kind = 'B';
- builtins[3].op = ne_error;
- strcpy(builtins[4].name,"ABS");
- builtins[4].kind = 'C';
- builtins[4].op = ne_error;
- strcpy(builtins[5].name,"SQRT");
- builtins[5].kind = 'B';
- builtins[5].op = ne_error;
- strcpy(builtins[6].name,"SIN");
- builtins[6].kind = 'B';
- builtins[6].op = ne_error;
- strcpy(builtins[7].name,"COS");
- builtins[7].kind = 'B';
- builtins[7].op = ne_error;
- strcpy(builtins[8].name,"TAN");
- builtins[8].kind = 'B';
- builtins[8].op = ne_error;
- strcpy(builtins[9].name,"ARCTAN");
- builtins[9].kind = 'B';
- builtins[9].op = ne_error;
- strcpy(builtins[10].name,"PI");
- builtins[10].kind = 'P';
- builtins[10].op = ne_error;
- desc->symtab = NULL;
- desc->casesens = false;
- desc->builtin = true;
- *desc->units = '\0';
- desc->scaled = false;
- desc->doubleeq = false;
- desc->error = (unsigned)ne_noerror;
- P_addsetr(P_expset(desc->startident, 0L), 'A', 'Z');
- P_addsetr(desc->startident, 'a', 'z');
- P_addset(desc->startident, '_');
- P_addsetr(P_expset(desc->ident, 0L), 'A', 'Z');
- P_addsetr(desc->ident, 'a', 'z');
- P_addsetr(desc->ident, '0', '9');
- P_addset(desc->ident, '_');
- desc->symproc.proc = (void*)dummysymproc;
- desc->symproc.link = (void*)NULL;
- desc->isfunc = false;
-}
-
-static void newnexrec(ne_nexrec **nex, long nargs, ne_opkind op)
-{
- *nex = (ne_nexrec *)Malloc(sizeof(ne_nexrec) + nargs * 4);
- (*nex)->nargs = nargs;
- (*nex)->op = (unsigned)op;
-}
-
-static void disposenexrec(ne_nexrec **nex)
-{
- Free(*nex);
-}
-
-void ne_copy(ne_nexrec *nex, ne_nexrec **newnex)
-{
- ne_opkind op;
- long i, FORLIM;
-
- if (nex == NULL)
- {
- *newnex = NULL;
- return;
- }
- op = (ne_opkind)nex->op;
- newnexrec(newnex, (long)nex->nargs, op);
- (*newnex)->UU.qw = nex->UU.qw;
- FORLIM = nex->nargs;
- for (i = 0; i < FORLIM; i++)
- ne_copy(nex->UU.U99.pvals[i], &(*newnex)->UU.U99.pvals[i]);
- if (op == ne_sc)
- nex->UU.s = (char *) strdup((*newnex)->UU.s);
-}
-
-void ne_dispose(ne_nexrec **nex)
-{
- long i, FORLIM;
-
- if (*nex == NULL)
- return;
- if ((ne_opkind)(*nex)->op == ne_sc)
- strdispose(&(*nex)->UU.s);
- FORLIM = (*nex)->nargs;
- for (i = 0; i < FORLIM; i++)
- ne_dispose(&(*nex)->UU.U99.pvals[i]);
- disposenexrec(nex);
-}
-
-static char *ne_errorkind_NAMES[] = {
- "NE_NOERROR", "NE_SYNTAX", "NE_OVERFLOW", "NE_UNDERFLOW", "NE_DIVZERO",
- "NE_STRLONG", "NE_BADTYPES", "NE_UNDEF", "NE_BADVAL"
-} ;
-
-static char *ne_opkind_NAMES[] = {
- "NE_ERROR", "NE_IC", "NE_RC", "NE_SC", "NE_IP", "NE_RP", "NE_SP", "NE_IF",
- "NE_RF", "NE_SF", "NE_IARG", "NE_RARG", "NE_SARG", "NE_IADD", "NE_ISUB",
- "NE_IMUL", "NE_IDIV", "NE_INEG", "NE_RADD", "NE_RSUB", "NE_RMUL", "NE_RDIV",
- "NE_RNEG", "NE_RPOW", "NE_SADD", "NE_ITOR", "NE_IMOD", "NE_RBOOL",
- "NE_SBOOL", "NE_IEQ", "NE_INE", "NE_ILT", "NE_ILE", "NE_IGT", "NE_IGE",
- "NE_REQ", "NE_RNE", "NE_RLT", "NE_RLE", "NE_RGT", "NE_RGE", "NE_SEQ",
- "NE_SNE", "NE_SLT", "NE_SLE", "NE_SGT", "NE_SGE", "NE_NOT", "NE_AND",
- "NE_OR", "NE_XOR", "NE_LSH", "NE_RSH", "NE_LNOT", "NE_IOR", "NE_ROR",
- "NE_SOR", "NE_IAND", "NE_RAND", "NE_SAND", "NE_ICOND", "NE_RCOND",
- "NE_SCOND", "NE_ROUND", "NE_TRUNC", "NE_LN", "NE_EXP", "NE_IABS", "NE_RABS",
- "NE_SQRT", "NE_SIN", "NE_COS", "NE_TAN", "NE_ARCTAN", "NE_RXP", "NE_RXOR"
-} ;
-
-void ne_dump(ne_nexrec *nex)
-{
- char buf[256];
- long i;
- ne_opkind op;
- char STR1[256];
- long FORLIM;
-
- if (nex == NULL)
- {
- printf("(nil)");
- return;
- }
- op = (ne_opkind)nex->op;
- switch (op)
- {
-
- case ne_ic:
- printf("%ld", nex->UU.i);
- break;
-
- case ne_rc:
- sprintf(buf, "%g", nex->UU.r);
- if (strpos2(buf, ".", 1) == 0 && strpos2(buf, "E", 1) == 0)
- strcat(buf, ".");
- fputs(buf, stdout);
- break;
-
- case ne_sc:
- printf("'%s'", nex->UU.s);
- break;
-
- case ne_ip:
- if (nex->UU.U10.ips != NULL)
- fputs(nex->UU.U10.ips->s, stdout);
- else
- printf("(i)");
- break;
-
- case ne_rp:
- case ne_rxp:
- if (nex->UU.U11.rps != NULL)
- fputs(nex->UU.U11.rps->s, stdout);
- else
- printf("(r)");
- break;
-
- case ne_sp:
- if (nex->UU.U12.sps != NULL)
- fputs(nex->UU.U12.sps->s, stdout);
- else
- printf("(s)");
- break;
-
- case ne_if:
- case ne_rf:
- case ne_sf:
- if (nex->UU.U15.fps != NULL)
- fputs(nex->UU.U15.fps->s, stdout);
- else
- printf("func");
- break;
-
- case ne_error:
- printf("error(%s)", ne_errorkind_NAMES[nex->UU.err]);
- break;
-
- default:
- strcpy(buf, ne_opkind_NAMES[(long)op]);
- i = strlen(buf) + 1;
- buf[i - 1] = '\0';
- strcpy_overlap(buf, buf + 3);
- fputs(strlower(STR1, buf), stdout);
- break;
- }
- if (nex->nargs <= 0)
- return;
- FORLIM = nex->nargs;
- for (i = 1; i <= FORLIM; i++)
- {
- if (i == 1)
- putchar('[');
- else
- putchar(',');
- ne_dump(nex->UU.U99.pvals[i - 1]);
- }
- putchar(']');
-}
-
-static int integerp(ne_nexrec *nex)
-{
- return (nex != NULL && types[nex->op] == ne_integer);
-}
-
-static int realp(ne_nexrec *nex)
-{
- return (nex != NULL && types[nex->op] == ne_real);
-}
-
-static int stringp(ne_nexrec *nex)
-{
- return (nex != NULL && types[nex->op] == ne_string);
-}
-
-ne_nexrec *ne_makeerror(ne_errorkind err)
-{
- ne_nexrec *nex;
-
- newnexrec(&nex, 0L, ne_error);
- nex->UU.err = (unsigned)err;
- return nex;
-}
-
-static void optimize (ne_nexrec **nex, ne_desc *desc, strlist_t *which, long mode);
-
-/* Local variables for optimize: */
-struct LOC_optimize
-{
- ne_desc *desc;
- strlist_t *which;
- long mode;
- ne_errorkind err;
- long ires;
- double rres;
- char sres[256];
-} ;
-
-/* Local variables for opt: */
-struct LOC_opt
-{
- struct LOC_optimize *LINK;
- ne_nexrec **nex;
-} ;
-
-static int makeconstant(char *name, struct LOC_opt *LINK)
-{
- if (LINK->LINK->mode == 1 || LINK->LINK->mode == 2)
- return ((strlist_find(LINK->LINK->which, name) != NULL) == (LINK->LINK->mode == 1));
- else
- return false;
-}
-
-static void error(ne_errorkind errk, struct LOC_opt *LINK)
-{
- LINK->LINK->err = errk;
- _Escape(2345);
-}
-
-static void collapsehalf(ne_nexrec *px, ne_nexrec *py, struct LOC_opt *LINK)
-{
- /*keep px, dispose py*/
- disposenexrec(LINK->nex);
- ne_dispose(&py);
- *LINK->nex = px;
-}
-
-static void collapsecond(ne_nexrec *px, ne_nexrec *py, ne_nexrec *pz, struct LOC_opt *LINK)
-{
- /*keep py, dispose px/pz*/
- disposenexrec(LINK->nex);
- ne_dispose(&px);
- ne_dispose(&pz);
- *LINK->nex = py;
-}
-
-static void collapseint(long res, struct LOC_opt *LINK)
-{
- ne_dispose(LINK->nex);
- newnexrec(LINK->nex, 0L, ne_ic);
- (*LINK->nex)->UU.i = res;
-}
-
-static void collapsereal(double res, struct LOC_opt *LINK)
-{
- ne_dispose(LINK->nex);
- newnexrec(LINK->nex, 0L, ne_rc);
- (*LINK->nex)->UU.r = res;
-}
-
-static void collapsestr(char *res, struct LOC_opt *LINK)
-{
- ne_dispose(LINK->nex);
- newnexrec(LINK->nex, 0L, ne_sc);
- (*LINK->nex)->UU.s = (char *)strdup(res);
-}
-
-static int istrue(ne_nexrec *nex, struct LOC_opt *LINK)
-{
- int Result;
-
- switch ((ne_opkind)nex->op)
- {
- case ne_ic:
- Result = (nex->UU.i != 0);
- break;
-
- case ne_rc:
- Result = (nex->UU.r != 0);
- break;
-
- case ne_sc:
- Result = (*nex->UU.s != '\0');
- break;
-
- default:
- Result = false;
- break;
- }
- return Result;
-}
-
-static int isfalse(ne_nexrec *nex, struct LOC_opt *LINK)
-{
- int Result;
-
- switch ((ne_opkind)nex->op)
- {
-
- case ne_error:
- Result = ((ne_errorkind)nex->UU.err == ne_badval);
- break;
-
- case ne_ic:
- Result = (nex->UU.i == 0);
- break;
-
- case ne_rc:
- Result = (nex->UU.r == 0);
- break;
-
- case ne_sc:
- Result = (*nex->UU.s == '\0');
- break;
-
- default:
- Result = false;
- break;
- }
- return Result;
-}
-
-static int foldfunction(struct LOC_opt *LINK)
-{
- int Result;
- long i1;
- ne_nexrec *WITH;
- long FORLIM;
-
- WITH = *LINK->nex;
- if (!WITH->UU.U15.fp->static_ || WITH->UU.U15.fp->subnex)
- return false;
- Result = true;
- FORLIM = WITH->nargs;
-
- for (i1 = 0; i1 < FORLIM; i1++)
- {
- if (WITH->UU.U99.pvals[i1]->op >= 32 ||
- ((1L << WITH->UU.U99.pvals[i1]->op) & ((1L << ((long)ne_ic)) | (1L << ((long)ne_rc)) | (1L << ((long)ne_sc)))) == 0)
- Result = false;
- }
- return Result;
-}
-
-static ne_nexrec *opt(ne_nexrec **nex_, struct LOC_optimize *LINK)
-{
- struct LOC_opt V;
- long i1;
- ne_nexrec *WITH;
- long FORLIM;
- char STR1[256];
-
- V.LINK = LINK;
- V.nex = nex_;
- if (*V.nex == NULL)
- return (*V.nex);
- WITH = *V.nex;
- if ((ne_opkind)WITH->op != (int)ne_scond &&
- (ne_opkind)WITH->op != (int)ne_sor &&
- (ne_opkind)WITH->op != (int)ne_sand &&
- (ne_opkind)WITH->op != (int)ne_rcond &&
- (ne_opkind)WITH->op != (int)ne_ror &&
- (ne_opkind)WITH->op != (int)ne_rand &&
- (ne_opkind)WITH->op != (int)ne_icond &&
- (ne_opkind)WITH->op != (int)ne_ior &&
- (ne_opkind)WITH->op != (int)ne_iand &&
- (ne_opkind)WITH->op != (int)ne_rxor &&
- (ne_opkind)WITH->op != (int)ne_lnot)
- {
- FORLIM = WITH->nargs;
- for (i1 = 0; i1 < FORLIM; i1++)
- WITH->UU.U99.pvals[i1] = opt(&WITH->UU.U99.pvals[i1], LINK);
- }
-
- /* optimize(pvals[i1], desc, which, mode); */
- switch ((ne_opkind)WITH->op)
- {
-
- case ne_error:
- error((ne_errorkind)WITH->UU.err, &V);
- break;
-
- case ne_ip:
- if (WITH->UU.U10.ips != NULL && makeconstant(WITH->UU.U10.ips->s, &V))
- {
- WITH->op = (unsigned)ne_ic;
- WITH->UU.i = *WITH->UU.U10.ip;
- }
- break;
-
- case ne_rp:
- case ne_rxp:
- if (WITH->UU.U11.rps != NULL && makeconstant(WITH->UU.U11.rps->s, &V))
- {
- WITH->op = (unsigned)ne_rc;
- WITH->UU.r = *WITH->UU.U11.rp;
- if ((ne_opkind)WITH->op == ne_rxp && WITH->UU.r == ne_badvalue)
- error(ne_badval, &V);
- }
- break;
-
- case ne_sp:
- if (WITH->UU.U12.sps != NULL && makeconstant(WITH->UU.U12.sps->s, &V))
- {
- WITH->op = (unsigned)ne_sc;
- WITH->UU.s = (char *)strdup(*WITH->UU.U12.sp);
- }
- break;
-
- case ne_if:
- if (foldfunction(&V))
- {
- if (WITH->UU.U15.fp->UU.U5.ipr.link != NULL)
- (*(void(*) (ne_nexrec *nex, long *res, void* _link)) WITH->UU.U15.fp->UU.U5.ipr.proc)(*V.nex, &LINK->ires,
- WITH->UU.U15.fp->UU.U5.ipr.link);
- else
- (*(void(*) (ne_nexrec *nex, long *res)) WITH->UU.U15.fp->UU.U5.ipr.proc)(*V.nex, &LINK->ires);
- collapseint(LINK->ires, &V);
- }
- break;
-
- case ne_rf:
- if (foldfunction(&V))
- {
- if (WITH->UU.U15.fp->UU.rpr.link != NULL)
- (*(void(*) (ne_nexrec *nex, double *res, void* _link)) WITH->UU.U15.fp->UU.rpr.proc)(*V.nex, &LINK->rres,
- WITH->UU.U15.fp->UU.rpr.link);
- else
- (*(void(*) (ne_nexrec *nex, double *res)) WITH->UU.U15.fp->UU.rpr.proc)(*V.nex, &LINK->rres);
- collapsereal(LINK->rres, &V);
- }
- break;
-
- case ne_sf:
- if (foldfunction(&V))
- {
- if (WITH->UU.U15.fp->UU.spr.link != NULL)
- (*(void(*) (ne_nexrec *nex, char *res, void* _link)) WITH->UU.U15.fp->UU.spr.proc)(*V.nex, LINK->sres,
- WITH->UU.U15.fp->UU.spr.link);
- else
- (*(void(*) (ne_nexrec *nex, char *res)) WITH->UU.U15.fp->UU.spr.proc)(*V.nex, LINK->sres);
- collapsestr(LINK->sres, &V);
- }
- break;
-
- case ne_iadd:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i + WITH->UU.U10.p2->UU.i, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_isub:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i - WITH->UU.U10.p2->UU.i, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_imul:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i * WITH->UU.U10.p2->UU.i, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 1)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 1)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- break;
-
- case ne_idiv:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i / WITH->UU.U10.p2->UU.i, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 1)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0)
- error(ne_divzero, &V);
- break;
-
- case ne_ineg:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic)
- collapseint(-WITH->UU.U10.p1->UU.i, &V);
- break;
-
- case ne_radd:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc &&(ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapsereal(WITH->UU.U10.p1->UU.r + WITH->UU.U10.p2->UU.r, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && WITH->UU.U10.p1->UU.r == 0)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_rc && WITH->UU.U10.p2->UU.r == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_rsub:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapsereal(WITH->UU.U10.p1->UU.r - WITH->UU.U10.p2->UU.r, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_rc && WITH->UU.U10.p2->UU.r == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_rmul:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapsereal(WITH->UU.U10.p1->UU.r * WITH->UU.U10.p2->UU.r, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && WITH->UU.U10.p1->UU.r == 1)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_rc && WITH->UU.U10.p2->UU.r == 1)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && WITH->UU.U10.p1->UU.r == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_rc &&
- WITH->UU.U10.p2->UU.r == 0)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- break;
-
- case ne_rdiv:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapsereal(WITH->UU.U10.p1->UU.r / WITH->UU.U10.p2->UU.r, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && WITH->UU.U10.p1->UU.r == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_rc && WITH->UU.U10.p2->UU.r == 1)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_rc && WITH->UU.U10.p2->UU.r == 0)
- error(ne_divzero, &V);
- break;
-
- case ne_rpow:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapsereal(ma_ytox(WITH->UU.U10.p1->UU.r, WITH->UU.U10.p2->UU.r), &V);
- break;
-
- case ne_rneg:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(-WITH->UU.U10.p1->UU.r, &V);
- break;
-
- case ne_sadd:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && (ne_opkind)WITH->UU.U10.p2->op == ne_sc)
- {
- if (strlen(WITH->UU.U10.p1->UU.s) + strlen(WITH->UU.U10.p2->UU.s) > 255)
- {
- error(ne_strlong, &V);
- }
- else
- {
- sprintf(STR1, "%s%s", WITH->UU.U10.p1->UU.s, WITH->UU.U10.p2->UU.s);
- collapsestr(STR1, &V);
- }
- }
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && *WITH->UU.U10.p1->UU.s == '\0')
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_sc && *WITH->UU.U10.p2->UU.s == '\0')
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_itor:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic)
- collapsereal((double)WITH->UU.U10.p1->UU.i, &V);
- break;
-
- case ne_imod:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- {
- collapseint(WITH->UU.U10.p1->UU.i % WITH->UU.U10.p2->UU.i, &V);
- }
- break;
-
- case ne_rbool:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapseint((long)(WITH->UU.U10.p1->UU.r != 0), &V);
- break;
-
- case ne_sbool:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc)
- collapseint((long)(*WITH->UU.U10.p1->UU.s != '\0'), &V);
- break;
-
- case ne_ieq:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint((long)(WITH->UU.U10.p1->UU.i == WITH->UU.U10.p2->UU.i), &V);
- break;
-
- case ne_ine:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint((long)(WITH->UU.U10.p1->UU.i != WITH->UU.U10.p2->UU.i), &V);
- break;
-
- case ne_ilt:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint((long)(WITH->UU.U10.p1->UU.i < WITH->UU.U10.p2->UU.i), &V);
- break;
-
- case ne_ile:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint((long)(WITH->UU.U10.p1->UU.i <= WITH->UU.U10.p2->UU.i), &V);
- break;
-
- case ne_igt:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint((long)(WITH->UU.U10.p1->UU.i > WITH->UU.U10.p2->UU.i), &V);
- break;
-
- case ne_ige:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint((long)(WITH->UU.U10.p1->UU.i >= WITH->UU.U10.p2->UU.i), &V);
- break;
-
- case ne_req:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapseint((long)(WITH->UU.U10.p1->UU.r == WITH->UU.U10.p2->UU.r), &V);
- break;
-
- case ne_rne:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapseint((long)(WITH->UU.U10.p1->UU.r != WITH->UU.U10.p2->UU.r), &V);
- break;
-
- case ne_rlt:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapseint((long)(WITH->UU.U10.p1->UU.r < WITH->UU.U10.p2->UU.r), &V);
- break;
-
- case ne_rle:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapseint((long)(WITH->UU.U10.p1->UU.r <= WITH->UU.U10.p2->UU.r), &V);
- break;
-
- case ne_rgt:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapseint((long)(WITH->UU.U10.p1->UU.r > WITH->UU.U10.p2->UU.r), &V);
- break;
-
- case ne_rge:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc && (ne_opkind)WITH->UU.U10.p2->op == ne_rc)
- collapseint((long)(WITH->UU.U10.p1->UU.r >= WITH->UU.U10.p2->UU.r), &V);
- break;
-
- case ne_seq:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && (ne_opkind)WITH->UU.U10.p2->op == ne_sc)
- collapseint((long)(strcmp(WITH->UU.U10.p1->UU.s, WITH->UU.U10.p2->UU.s) == 0), &V);
- break;
-
- case ne_sne:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && (ne_opkind)WITH->UU.U10.p2->op == ne_sc)
- collapseint((long)(strcmp(WITH->UU.U10.p1->UU.s, WITH->UU.U10.p2->UU.s) != 0), &V);
- break;
-
- case ne_slt:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && (ne_opkind)WITH->UU.U10.p2->op == ne_sc)
- collapseint((long)(strcmp(WITH->UU.U10.p1->UU.s, WITH->UU.U10.p2->UU.s) < 0), &V);
- break;
-
- case ne_sle:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && (ne_opkind)WITH->UU.U10.p2->op == ne_sc)
- collapseint((long)(strcmp(WITH->UU.U10.p1->UU.s, WITH->UU.U10.p2->UU.s) <= 0), &V);
- break;
-
- case ne_sgt:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && (ne_opkind)WITH->UU.U10.p2->op == ne_sc)
- collapseint((long)(strcmp(WITH->UU.U10.p1->UU.s, WITH->UU.U10.p2->UU.s) > 0), &V);
- break;
-
- case ne_sge:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_sc && (ne_opkind)WITH->UU.U10.p2->op == ne_sc)
- collapseint((long)(strcmp(WITH->UU.U10.p1->UU.s, WITH->UU.U10.p2->UU.s) >= 0), &V);
- break;
-
- case ne_not:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic)
- collapseint(~WITH->UU.U10.p1->UU.i, &V);
- break;
-
- case ne_and:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i & WITH->UU.U10.p2->UU.i, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == -1)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == -1)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- break;
-
- case ne_or:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i | WITH->UU.U10.p2->UU.i, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == -1)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == -1)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- break;
-
- case ne_xor:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i ^ WITH->UU.U10.p2->UU.i, &V);
- else if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0)
- collapsehalf(WITH->UU.U10.p2, WITH->UU.U10.p1, &V);
- else if ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0)
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_lsh:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i << WITH->UU.U10.p2->UU.i, &V);
- else if (((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0) ||
- ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0))
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_rsh:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic && (ne_opkind)WITH->UU.U10.p2->op == ne_ic)
- collapseint(WITH->UU.U10.p1->UU.i >> WITH->UU.U10.p2->UU.i, &V);
- else if (((ne_opkind)WITH->UU.U10.p1->op == ne_ic && WITH->UU.U10.p1->UU.i == 0) ||
- ((ne_opkind)WITH->UU.U10.p2->op == ne_ic && WITH->UU.U10.p2->UU.i == 0))
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_lnot:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (istrue(WITH->UU.U10.p1, &V))
- collapseint(0L, &V);
- else if (isfalse(WITH->UU.U10.p1, &V))
- collapseint(1L, &V);
- break;
-
- case ne_iand:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (istrue(WITH->UU.U10.p1, &V))
- collapsehalf(opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p1, &V);
- else if (isfalse(WITH->UU.U10.p1, &V))
- collapseint(0L, &V);
- break;
-
- case ne_ior:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (isfalse(WITH->UU.U10.p1, &V))
- collapsehalf(opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p1, &V);
- else if (istrue(WITH->UU.U10.p1, &V))
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_rand:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (istrue(WITH->UU.U10.p1, &V))
- collapsehalf(opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p1, &V);
- else if (isfalse(WITH->UU.U10.p1, &V))
- collapsereal(0.0, &V);
- break;
-
- case ne_ror:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (isfalse(WITH->UU.U10.p1, &V))
- collapsehalf(opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p1, &V);
- else if (istrue(WITH->UU.U10.p1, &V))
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_rxor:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_error && (ne_errorkind)WITH->UU.U10.p1->UU.err == ne_badval)
- collapsehalf(opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p1, &V);
- else if (istrue(WITH->UU.U10.p1, &V))
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_sand:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (istrue(WITH->UU.U10.p1, &V))
- collapsehalf(opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p1, &V);
- else if (isfalse(WITH->UU.U10.p1, &V))
- collapsestr("", &V);
- break;
-
- case ne_sor:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (isfalse(WITH->UU.U10.p1, &V))
- collapsehalf(opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p1, &V);
- else if (istrue(WITH->UU.U10.p1, &V))
- collapsehalf(WITH->UU.U10.p1, WITH->UU.U10.p2, &V);
- break;
-
- case ne_icond:
- case ne_rcond:
- case ne_scond:
- optimize(&WITH->UU.U10.p1, LINK->desc, LINK->which, LINK->mode);
- if (isfalse(WITH->UU.U10.p1, &V))
- collapsecond(WITH->UU.U10.p1, opt(&WITH->UU.U10.p3, LINK), WITH->UU.U10.p2, &V);
- else if (istrue(WITH->UU.U10.p1, &V))
- collapsecond(WITH->UU.U10.p1, opt(&WITH->UU.U10.p2, LINK), WITH->UU.U10.p3, &V);
- break;
-
- case ne_round:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapseint((long)floor(WITH->UU.U10.p1->UU.r + 0.5), &V);
- break;
-
- case ne_trunc:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapseint((long)WITH->UU.U10.p1->UU.r, &V);
- break;
-
- case ne_ln:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(log(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- case ne_exp:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(exp(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- case ne_iabs:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_ic)
- collapseint(labs(WITH->UU.U10.p1->UU.i), &V);
- break;
-
- case ne_rabs:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(fabs(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- case ne_sqrt:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(sqrt(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- case ne_sin:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(sin(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- case ne_cos:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(cos(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- case ne_tan:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(tan(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- case ne_arctan:
- if ((ne_opkind)WITH->UU.U10.p1->op == ne_rc)
- collapsereal(atan(WITH->UU.U10.p1->UU.r), &V);
- break;
-
- default:
- break;
- }
- return (*V.nex);
-}
-
-
-static void optimize(ne_nexrec **nex, ne_desc *desc_, strlist_t *which_, long mode_)
-{
- struct LOC_optimize V;
-
- V.desc = desc_;
- V.which = which_;
- V.mode = mode_;
- V.err = ne_noerror;
- TRY(try1);
- *nex = opt(nex, &V);
- RECOVER(try1);
- if (P_escapecode == -20)
- _Escape(P_escapecode);
- if (V.err == ne_noerror)
- {
- switch (P_escapecode)
- {
- case -5:
- V.err = ne_divzero;
- break;
-
- case -7:
- V.err = ne_underflow;
- break;
-
- default:
- V.err = ne_overflow;
- break;
- }
- }
- ne_dispose(nex);
- *nex = ne_makeerror(V.err);
- ENDTRY(try1);
- if ((ne_opkind)(*nex)->op == ne_error)
- V.desc->error = (unsigned)((ne_errorkind)(*nex)->UU.err);
- else
- V.desc->error = (unsigned)ne_noerror;
-}
-
-
-void ne_constant(ne_nexrec **nex, ne_desc *desc, char *which_)
-{
- char which[256];
- strlist_t *l1, *l2;
- char buf[256];
-
- strcpy(which, which_);
- if (!desc->casesens)
- strupper(which, which);
- l1 = NULL;
- do {
- strword(which, buf);
- if (*buf != '\0')
- l2 = strlist_add(&l1, buf);
- } while (*which != '\0');
- optimize(nex, desc, l1, 1L);
- strlist_empty(&l1);
-}
-
-
-void ne_notconstant(ne_nexrec **nex, ne_desc *desc, char *which_)
-{
- char which[256];
- strlist_t *l1, *l2;
- char buf[256];
-
- strcpy(which, which_);
- if (!desc->casesens)
- strupper(which, which);
- l1 = NULL;
- do {
- strword(which, buf);
- if (*buf != '\0')
- l2 = strlist_add(&l1, buf);
- } while (*which != '\0');
- optimize(nex, desc, l1, 2L);
- strlist_empty(&l1);
-}
-
-
-void ne_constantlist(ne_nexrec **nex, ne_desc *desc, strlist_t *which)
-{
- optimize(nex, desc, which, 1L);
-}
-
-void ne_notconstantlist(ne_nexrec **nex, ne_desc *desc, strlist_t *which)
-{
- optimize(nex, desc, which, 2L);
-}
-
-static ne_nexrec *make2(ne_opkind op, ne_nexrec *nex, ne_nexrec *nex2)
-{
- ne_nexrec *n;
-
- newnexrec(&n, (long)((nex != NULL) + (nex2 != NULL)), op);
- n->UU.U10.p1 = nex;
- n->UU.U10.p2 = nex2;
- return n;
-}
-
-static ne_nexrec *make3(ne_opkind op, ne_nexrec *nex, ne_nexrec *nex2, ne_nexrec *nex3)
-{
- ne_nexrec *n;
-
- newnexrec(&n, 3L, op);
- n->UU.U10.p1 = nex;
- n->UU.U10.p2 = nex2;
- n->UU.U10.p3 = nex3;
- return n;
-}
-
-ne_nexrec *ne_typecast(ne_nexrec *nex, ne_datatype typ)
-{
- switch (typ)
- {
-
- case ne_notype:
- ne_dispose(&nex);
- nex = ne_makeerror(ne_badtypes);
- break;
-
- case ne_integer:
- if (realp(nex))
- {
- nex = make2(ne_round, nex, NULL);
- }
- else if (!integerp(nex))
- {
- ne_dispose(&nex);
- nex = ne_makeerror(ne_badtypes);
- }
- break;
-
- case ne_real:
- if (integerp(nex))
- {
- nex = make2(ne_itor, nex, NULL);
- }
- else if (!realp(nex))
- {
- ne_dispose(&nex);
- nex = ne_makeerror(ne_badtypes);
- }
- break;
-
- case ne_string:
- if (!stringp(nex))
- {
- ne_dispose(&nex);
- nex = ne_makeerror(ne_badtypes);
- }
- break;
-
- case ne_boolean:
- if (realp(nex))
- nex = make2(ne_rbool, nex, NULL);
- else if (stringp(nex))
- nex = make2(ne_sbool, nex, NULL);
- break;
- }
- return nex;
-}
-
-
-/* Local variables for ne_intcompile: */
-struct LOC_ne_intcompile
-{
- char *ex;
- ne_desc *desc;
- long p;
-} ;
-
-static ne_nexrec *expr (long prec, struct LOC_ne_intcompile *LINK);
-
-static void seterror(ne_errorkind errk, struct LOC_ne_intcompile *LINK)
-{
- if ((ne_errorkind)LINK->desc->error == ne_noerror)
- LINK->desc->error = (unsigned)errk;
- LINK->p = 0;
- while (LINK->ex[LINK->p - 1] != '\0')
- LINK->p++;
-}
-
-static void error_(ne_errorkind errk, ne_nexrec **nex1, ne_nexrec *nex2, struct LOC_ne_intcompile *LINK)
-{
- ne_dispose(nex1);
- ne_dispose(&nex2);
- seterror(errk, LINK);
-}
-
-static char skipspc(struct LOC_ne_intcompile *LINK)
-{
- while (LINK->ex[LINK->p - 1] == ' ')
- LINK->p++;
- return (LINK->ex[LINK->p - 1]);
-}
-
-/* Local variables for expr: */
-struct LOC_expr
-{
- struct LOC_ne_intcompile *LINK;
-} ;
-
-static ne_nexrec *parexp(struct LOC_expr *LINK)
-{
- ne_nexrec *nex;
- char ch, ch2;
-
- nex = NULL;
- ch = skipspc(LINK->LINK);
- if (ch != '(' && ch != '[') {
- error_(ne_syntax, &nex, NULL, LINK->LINK);
- return nex;
- }
- LINK->LINK->p++;
- nex = expr(0L, LINK->LINK);
- ch2 = skipspc(LINK->LINK);
- if ((ch == '(' && ch2 == ')') || (ch == '[' && ch2 == ']'))
- LINK->LINK->p++;
- else
- error_(ne_syntax, &nex, NULL, LINK->LINK);
- return nex;
-}
-
-static ne_nexrec *factor(struct LOC_expr *LINK)
-{
- char ch, ch2, kind;
- char name[256];
- ne_nexrec *nex;
- ne_nexrec **args;
- ne_datatype atype;
- na_long value;
- strlist_t *l1;
- double *rp;
- ne_functionrec *fp;
- long i, p0;
- double r;
- int done;
- char TEMP;
- long FORLIM;
- int allocdone; /* flag for deallocation */
- void* tryalloc;
-
- nex = NULL;
- allocdone = 0;
- ch = skipspc(LINK->LINK);
- if (P_inset(ch, LINK->LINK->desc->startident))
- {
- *name = '\0';
- while (P_inset(LINK->LINK->ex[LINK->LINK->p - 1], LINK->LINK->desc->ident) ||
- P_inset(LINK->LINK->ex[LINK->LINK->p - 1], LINK->LINK->desc->startident))
- {
- sprintf(name + strlen(name), "%c", LINK->LINK->ex[LINK->LINK->p - 1]);
- LINK->LINK->p++;
- }
- if (!LINK->LINK->desc->casesens)
- strupper(name, name);
- ch = skipspc(LINK->LINK);
- LINK->LINK->desc->isfunc = (ch == '[' || ch == '(');
- kind = ' ';
- l1 = NULL;
- if (LINK->LINK->desc->symproc.link != NULL)
- (*(void(*) (char *name, ne_desc *desc, strlist_t **symptr, void* _link))LINK->LINK->desc->symproc.proc)(name,
- LINK->LINK->desc, &l1, LINK->LINK->desc->symproc.link);
- else
- (*(void(*) (char *name, ne_desc *desc, strlist_t **symptr)) LINK->LINK->desc->symproc.proc)(name, LINK->LINK->desc, &l1);
- if (l1 != NULL)
- {
- kind = l1->kind;
- value = l1->value;
- } else {
- kind = 255;
- }
- switch (kind)
- {
-
- case ne_kind_intconst:
- nex = make2(ne_ic, NULL, NULL);
- nex->UU.i = (long)value;
- break;
-
- case ne_kind_intvalue:
- nex = make2(ne_ip, NULL, NULL);
- nex->UU.U10.ip = (long*)(&l1->value);
- nex->UU.U10.ips = l1;
- break;
-
- case ne_kind_intptr:
- nex = make2(ne_ip, NULL, NULL);
- nex->UU.U10.ip = (long *)value;
- nex->UU.U10.ips = l1;
- break;
-
- case ne_kind_realconst:
- nex = make2(ne_rc, NULL, NULL);
- rp = (double *)value;
- nex->UU.r = *rp;
- break;
-
- case ne_kind_srealconst:
- nex = make2(ne_rc, NULL, NULL);
- nex->UU.r = na_srtor(value);
- break;
-
- case ne_kind_realptr:
- nex = make2(ne_rp, NULL, NULL);
- nex->UU.U11.rp = (double *)value;
- nex->UU.U11.rps = l1;
- break;
-
- case ne_kind_realxptr:
- nex = make2(ne_rxp, NULL, NULL);
- nex->UU.U11.rp = (double *)value;
- nex->UU.U11.rps = l1;
- break;
-
- case ne_kind_strconst:
- nex = make2(ne_sc, NULL, NULL);
- nex->UU.s = (char *)strdup((char *)value);
- break;
-
- case ne_kind_strvalue:
- nex = make2(ne_sp, NULL, NULL);
- nex->UU.U12.sp = (char **)(&l1->value);
- nex->UU.U12.sps = l1;
- break;
-
- case ne_kind_strptr:
- nex = make2(ne_sp, NULL, NULL);
- nex->UU.U12.sp = (char **)value;
- nex->UU.U12.sps = l1;
- break;
-
- case ne_kind_intfunc:
- case ne_kind_realfunc:
- case ne_kind_strfunc:
- fp = (ne_functionrec *)value;
- tryalloc = (void* *)(&args); /*G. Liu + */
- na_alloc(tryalloc,fp->maxargs *sizeof(ne_nexrec *)); /* G. Liu + */
- allocdone = 1;
- i = 0;
- if (ch == '[' || ch == '(') {
- LINK->LINK->p++;
- TEMP = skipspc(LINK->LINK);
- if (!(TEMP == ']' || TEMP == ')'))
- {
- done = false;
- while (!done && i < fp->maxargs)
- {
- i++;
- if (fp->nargs > 0)
- {
- atype = fp->UU.U99.ptypes[P_imin2(i, (long)fp->nargs) - 1];
- args[i - 1] = ne_typecast(expr(0L, LINK->LINK), atype);
- }
- else if (fp->subnex)
- {
- args[i - 1] = ne_typecast(expr(0L, LINK->LINK), ne_real);
- }
- else
- {
- args[i - 1] = expr(0L, LINK->LINK);
- }
-
- if ((ne_opkind)args[i - 1]->op == ne_error)
- error_((ne_errorkind)args[i - 1]->UU.err, &args[i - 1], NULL, LINK->LINK);
-
- if (skipspc(LINK->LINK) == ',')
- LINK->LINK->p++;
- else
- done = true;
- }
- if (!done)
- seterror(ne_syntax, LINK->LINK);
- }
- ch2 = skipspc(LINK->LINK);
- if ((ch == '(' && ch2 == ')') || (ch == '[' && ch2 == ']'))
- LINK->LINK->p++;
- else
- seterror(ne_syntax, LINK->LINK);
- }
- if (i < fp->minargs)
- seterror(ne_syntax, LINK->LINK);
- if ((ne_errorkind)LINK->LINK->desc->error == ne_noerror)
- {
- switch (kind)
- {
-
- case ne_kind_intfunc:
- newnexrec(&nex, i, ne_if);
- break;
-
- case ne_kind_realfunc:
- newnexrec(&nex, i, ne_rf);
- break;
-
- case ne_kind_strfunc:
- newnexrec(&nex, i, ne_sf);
- break;
- }
- FORLIM = nex->nargs;
- for (i = 0; i < FORLIM; i++)
- nex->UU.U99.pvals[i] = args[i];
- nex->UU.U15.fp = fp;
- nex->UU.U15.fps = l1;
- }
- break;
-
- case ne_kind_intarg:
- nex = make2(ne_iarg, NULL, NULL);
- nex->UU.i = (long)value;
- break;
-
- case ne_kind_realarg:
- nex = make2(ne_rarg, NULL, NULL);
- nex->UU.i = (long)value;
- break;
-
- case ne_kind_strarg:
- nex = make2(ne_sarg, NULL, NULL);
- nex->UU.i = (long)value;
- break;
-
- case ne_kind_nex:
- if (value == NULL)
- error_(ne_undef, &nex, NULL, LINK->LINK);
- else
- ne_copy((ne_nexrec *)value, &nex);
- break;
-
- default:
- if (LINK->LINK->desc->builtin)
- {
- i = numbuiltins;
- while (i >= 1 && strcmp(builtins[i - 1].name, name))
- i--;
- } else
- i = 0;
- if (i >= 1)
- {
- switch (builtins[i - 1].kind)
- {
-
- case 'A':
- nex = parexp(LINK);
- if (realp(nex))
- nex = make2(builtins[i - 1].op, nex, NULL);
- else if (!integerp(nex))
- error_(ne_badtypes, &nex, NULL, LINK->LINK);
- break;
-
- case 'B':
- nex = ne_typecast(parexp(LINK), ne_real);
- if ((ne_opkind)nex->op == ne_error)
- error_((ne_errorkind)nex->UU.err, &nex, NULL, LINK->LINK);
- nex = make2(builtins[i - 1].op, nex, NULL);
- break;
-
- case 'C':
- nex = parexp(LINK);
- if (integerp(nex))
- nex = make2(builtins[i - 1].op, nex, NULL);
- else if (realp(nex))
- nex = make2((ne_opkind)((long)builtins[i - 1].op + 1), nex, NULL);
- else
- error_(ne_badtypes, &nex, NULL, LINK->LINK);
- break;
-
- case 'P':
- nex = make2(ne_rc, NULL, NULL);
- nex->UU.r = 3.1415926536;
- break;
- }
- } else
- error_(ne_undef, &nex, NULL, LINK->LINK);
- break;
- }
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- if (ch == '+')
- {
- LINK->LINK->p++;
- nex = expr((long)neg_prec, LINK->LINK);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- if (ch == '-')
- {
- LINK->LINK->p++;
- nex = expr((long)neg_prec, LINK->LINK);
- if (realp(nex)) {
- nex = make2(ne_rneg, nex, NULL);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
- if (integerp(nex))
- nex = make2(ne_ineg, nex, NULL);
- else
- error_(ne_badtypes, &nex, NULL, LINK->LINK);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- if (ch == '!')
- {
- LINK->LINK->p++;
- nex = ne_typecast(expr((long)lnot_prec, LINK->LINK), ne_boolean);
- nex = make2(ne_lnot, nex, NULL);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- if (ch == '~')
- {
- LINK->LINK->p++;
- nex = expr((long)not_prec, LINK->LINK);
- if (realp(nex))
- nex = make2(ne_round, nex, NULL);
- if (integerp(nex))
- nex = make2(ne_not, nex, NULL);
- else
- error_(ne_badtypes, &nex, NULL, LINK->LINK);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- if (ch == '#' || ch == '\'' || ch == '"')
- {
- *name = '\0';
- done = false;
- do
- {
- ch = skipspc(LINK->LINK);
- if (ch == '#')
- {
- ch = toupper(LINK->LINK->ex[LINK->LINK->p]);
- if (ch >= '@' && ch <= '_')
- {
- sprintf(name + strlen(name), "%c", ch - 64);
- LINK->LINK->p += 2;
- }
- else if (isdigit(ch))
- {
- i = 0;
- LINK->LINK->p++;
- while (isdigit(LINK->LINK->ex[LINK->LINK->p - 1]))
- {
- i = i * 10 + LINK->LINK->ex[LINK->LINK->p - 1] - 48;
- LINK->LINK->p++;
- }
- sprintf(name + strlen(name), "%c", (char)(i & 255));
- }
- else
- {
- done = true;
- }
- }
- else if (ch == '\'' || ch == '"')
- {
- done = false;
- do
- {
- LINK->LINK->p++;
- if (LINK->LINK->ex[LINK->LINK->p - 1] == ch)
- {
- if (LINK->LINK->ex[LINK->LINK->p] == ch)
- {
- sprintf(name + strlen(name), "%c", ch);
- LINK->LINK->p++;
- }
- else
- {
- done = true;
- }
- }
- else if (LINK->LINK->ex[LINK->LINK->p - 1] == '\0')
- {
- done = true;
- }
- else
- {
- sprintf(name + strlen(name), "%c", LINK->LINK->ex[LINK->LINK->p - 1]);
- }
- } while (!done);
- if (LINK->LINK->ex[LINK->LINK->p - 1] == ch)
- LINK->LINK->p++;
- done = false;
- }
- else
- {
- done = true;
- }
- } while (!done);
- nex = make2(ne_sc, nex, NULL);
- nex->UU.s = (char *)strdup(name);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- if (ch == '[' || ch == '(')
- {
- nex = parexp(LINK);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- if (!(ch == '.' || isdigit(ch)))
- {
- error_(ne_syntax, &nex, NULL, LINK->LINK);
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- i = 0;
- p0 = LINK->LINK->p;
- while (isdigit(LINK->LINK->ex[LINK->LINK->p - 1]) && (i < 214748364L ||
- (i == 214748364L && LINK->LINK->ex[LINK->LINK->p - 1] >= '0' &&
- LINK->LINK->ex[LINK->LINK->p - 1] <= '7')))
- {
- i = i * 10 + LINK->LINK->ex[LINK->LINK->p - 1] - '0';
- LINK->LINK->p++;
- }
- TEMP = skipspc(LINK->LINK);
-
- if (!(TEMP == '.' || isalnum(TEMP)))
- {
- nex = make2(ne_ic, NULL, NULL);
- nex->UU.i = i;
- if (allocdone)
- na_free((void*)&args);
- return nex;
- }
-
- LINK->LINK->p = p0;
- if (readreal(LINK->LINK->ex, &LINK->LINK->p, &r, LINK->LINK->desc))
- {
- nex = make2(ne_rc, NULL, NULL);
- nex->UU.r = r;
- }
- else
- {
- error_(ne_syntax, &nex, NULL, LINK->LINK);
- }
-
- if (allocdone)
- {
- na_free((void*)&args);
- }
- return nex;
-}
-
-static ne_nexrec *expr(long prec, struct LOC_ne_intcompile *LINK)
-{
- struct LOC_expr V;
- ne_nexrec *nex, *nex2, *nex3;
- char ch;
- long opn, dp;
-
- V.LINK = LINK;
- nex = factor(&V);
- do
- {
- ch = skipspc(LINK);
- dp = 1;
- if (ch == '=' && LINK->ex[LINK->p] == '=')
- {
- dp = 2;
- }
- else if (ch == '!' && LINK->ex[LINK->p] == '=')
- {
- ch = '\001'; /*ne*/
- dp = 2;
- }
- else if (ch == '<')
- {
- if (LINK->ex[LINK->p] == '>')
- {
- ch = '\001'; /*ne*/
- dp = 2;
- }
- else if (LINK->ex[LINK->p] == '=')
- {
- ch = '\002'; /*le*/
- dp = 2;
- }
- else if (LINK->ex[LINK->p] == '<')
- {
- ch = '\006'; /*lsh*/
- dp = 2;
- }
- }
- else if (ch == '>')
- {
- if (LINK->ex[LINK->p] == '=')
- {
- ch = '\003'; /*ge*/
- dp = 2;
- }
- else if (LINK->ex[LINK->p] == '>')
- {
- ch = '\007'; /*rsh*/
- dp = 2;
- }
- }
- else if (ch == '&' && LINK->ex[LINK->p] == '&')
- {
- ch = '\004'; /*log. and*/
- dp = 2;
- }
- else if (ch == '|' && LINK->ex[LINK->p] == '|')
- {
- ch = '\005'; /*log. or*/
- dp = 2;
- }
- else if (ch == '!' && LINK->ex[LINK->p] == '!')
- {
- ch = '\b'; /*log. X-checking or*/
- dp = 2;
- }
-
- opn = numopersyms;
- while (opn >= 1 && opers[opn - 1].name != ch)
- opn--;
-
- if (opn >= 1 && opers[opn - 1].lprec > prec)
- {
- if (ch == '?')
- {
- LINK->p++;
- nex = ne_typecast(nex, ne_boolean);
- nex2 = expr(0L, LINK);
- if (skipspc(LINK) == ':')
- {
- LINK->p++;
- nex3 = expr((long)opers[opn - 1].rprec, LINK);
- if (stringp(nex2) && stringp(nex3))
- {
- nex = make3(ne_scond, nex, nex2, nex3);
- }
- else if (!stringp(nex2) && !stringp(nex3))
- {
- if (realp(nex2) || realp(nex3))
- nex = make3(ne_rcond, nex, ne_typecast(nex2, ne_real), ne_typecast(nex3, ne_real));
- else
- nex = make3(ne_icond, nex, nex2, nex3);
- }
- else
- {
- ne_dispose(&nex3);
- error_(ne_badtypes, &nex, nex2, LINK);
- }
- }
- else
- {
- error_(ne_syntax, &nex, nex2, LINK);
- }
- }
- else
- {
- LINK->p += dp;
- nex2 = expr((long)opers[opn - 1].rprec, LINK);
- if (stringp(nex) && stringp(nex2) && (ne_opkind)opers[opn - 1].sop != ne_error)
- {
- nex = make2((ne_opkind)opers[opn - 1].sop, nex, nex2);
- }
- else if (stringp(nex) || stringp(nex2))
- {
- error_(ne_badtypes, &nex, nex2, LINK);
- }
- else if (integerp(nex) && integerp(nex2) && (ne_opkind)opers[opn - 1].iop != ne_error)
- {
- nex = make2((ne_opkind)opers[opn - 1].iop, nex, nex2);
- }
- else if ((ne_opkind)opers[opn - 1].rop != ne_error)
- {
- if (integerp(nex))
- nex = make2(ne_itor, nex, NULL);
- if (integerp(nex2))
- nex2 = make2(ne_itor, nex2, NULL);
- nex = make2((ne_opkind)opers[opn - 1].rop, nex, nex2);
- }
- else
- {
- if (realp(nex))
- nex = make2(ne_round, nex, NULL);
- if (realp(nex2))
- nex2 = make2(ne_round, nex2, NULL);
- nex = make2((ne_opkind)opers[opn - 1].iop, nex, nex2);
- }
- }
- }
- } while (opn >= 1 && opers[opn - 1].lprec > prec);
-
- return nex;
-}
-
-
-void ne_intcompile(char *ex_, long *endp, ne_nexrec **nex, ne_desc *desc_)
-{
- struct LOC_ne_intcompile V;
- long startp;
-
- V.ex = ex_;
- V.desc = desc_;
- *nex = NULL;
- V.desc->error = (unsigned)ne_noerror;
- V.p = *endp;
- startp = *endp;
- *nex = expr(0L, &V);
- if ((ne_errorkind)V.desc->error == ne_noerror)
- {
- *endp = V.p;
- return;
- }
- ne_dispose(nex);
- *nex = ne_makeerror((ne_errorkind)V.desc->error);
- *endp = startp;
-}
-
-
-void ne_compile(char *ex_, ne_nexrec **nex, ne_desc *desc)
-{
- char ex[256];
- long len, endp;
- char STR1[256];
-
- strcpy(ex, ex_);
- if (strlen(ex) == 255)
- {
- desc->error = (unsigned)ne_strlong;
- *nex = ne_makeerror(ne_strlong);
- return;
- }
- len = strlen(ex);
- strcpy(STR1, ex);
- strcpy(ex, STR1);
- endp = 1;
- ne_intcompile(ex, &endp, nex, desc);
- if (endp == len + 1)
- {
- if ((ne_errorkind)desc->error == ne_noerror)
- optimize(nex, desc, NULL, 0L);
- return;
- }
- desc->error = (unsigned)ne_syntax;
- ne_dispose(nex);
- *nex = ne_makeerror(ne_syntax);
-}
-
-/* Local variables for ne_uncompile: */
-struct LOC_ne_uncompile
-{
- char *ex;
- ne_desc *desc;
- ne_opkind lastop;
- char ch;
- int flag;
-} ;
-
-static void uncompile (ne_nexrec *nex, int prec, struct LOC_ne_uncompile *LINK);
-
-static void append(char *s, struct LOC_ne_uncompile *LINK)
-{
- long i;
-
- i = strlen(LINK->ex) + strlen(s) - 255;
- if (i < 1) {
- strcat(LINK->ex, s);
- return;
- }
- if (i > 1)
- sprintf(LINK->ex + strlen(LINK->ex), "%.*s", (int)(i - 1), s);
- LINK->desc->error = (unsigned)ne_strlong;
-}
-
-static void appendc(char ch, struct LOC_ne_uncompile *LINK)
-{
- if (strlen(LINK->ex) < 255)
- sprintf(LINK->ex + strlen(LINK->ex), "%c", ch);
- else
- LINK->desc->error = (unsigned)ne_strlong;
-}
-
-static void appenderrname(ne_nexrec *nex, struct LOC_ne_uncompile *LINK)
-{
- char buf[256];
- long i;
- char STR1[256];
-
- strcpy(buf, ne_errorkind_NAMES[nex->UU.err]);
- i = strlen(buf) + 1;
- buf[i - 1] = '\0';
- strcpy_overlap(buf, buf + 3);
- append(strlower(STR1, buf), LINK);
-}
-
-/* Local variables for uncompile: */
-struct LOC_uncompile
-{
- struct LOC_ne_uncompile *LINK;
- ne_nexrec *nex;
-} ;
-
-static void args(struct LOC_uncompile *LINK)
-{
- long i1;
- ne_nexrec *WITH;
- long FORLIM;
-
- WITH = LINK->nex;
- if (WITH->nargs == 0)
- return;
- appendc('(', LINK->LINK);
- FORLIM = WITH->nargs;
- for (i1 = 1; i1 <= FORLIM; i1++) {
- if (i1 > 1)
- appendc(',', LINK->LINK);
- uncompile(WITH->UU.U99.pvals[WITH->UU.i - 1], 0, LINK->LINK);
- }
- appendc(')', LINK->LINK);
-}
-
-static void func(char *name, struct LOC_uncompile *LINK)
-{
- append(name, LINK->LINK);
- args(LINK);
-}
-
-static void uncompile(ne_nexrec *nex_, int prec, struct LOC_ne_uncompile *LINK)
-{
- struct LOC_uncompile V;
- ne_nexrec *nex2;
- long j;
- ne_nexrec *WITH;
- char STR1[256];
- long FORLIM;
-
- V.LINK = LINK;
- V.nex = nex_;
- WITH = V.nex;
- LINK->lastop = (ne_opkind)WITH->op;
- switch ((ne_opkind)WITH->op)
- {
-
- case ne_error:
- append("error(", LINK);
- appenderrname(V.nex, LINK);
- appendc(')', LINK);
- break;
-
- case ne_ic:
- if (LINK->desc->scaled)
- {
- append(realunit(STR1, (double)WITH->UU.i, LINK->desc->units), LINK);
- }
- else
- {
- sprintf(STR1, "%ld", WITH->UU.i);
- append(STR1, LINK);
- }
- break;
-
- case ne_rc:
- if (LINK->desc->scaled)
- {
- append(realunit(STR1, WITH->UU.r, LINK->desc->units), LINK);}
- else
- {
- sprintf(STR1, "%g", WITH->UU.r);
- append(STR1, LINK);
- }
- break;
-
- case ne_sc:
- if (*WITH->UU.s == '\0')
- append("''", LINK);
- else {
- LINK->flag = false;
- FORLIM = strlen(WITH->UU.s);
- for (j = 0; j < FORLIM; j++) {
- if (WITH->UU.s[j] < ' ' || WITH->UU.s[j] > '~')
- {
- if (LINK->flag)
- appendc('\'', LINK);
- appendc('#', LINK);
- sprintf(STR1, "%d", WITH->UU.s[j]);
- append(STR1, LINK);
- LINK->flag = false;
- }
- else
- {
- if (!LINK->flag)
- appendc('\'', LINK);
- appendc(WITH->UU.s[j], LINK);
- if (WITH->UU.s[j] == '\'')
- appendc('\'', LINK);
- LINK->flag = true;
- }
- }
- if (LINK->flag)
- appendc('\'', LINK);
- }
- break;
-
- case ne_ip:
- case ne_rp:
- case ne_sp:
- case ne_rxp:
- if (WITH->UU.U10.ips != NULL)
- append(WITH->UU.U10.ips->s, LINK);
- else
- append("(var)", LINK);
- break;
-
- case ne_if:
- case ne_rf:
- case ne_sf:
- if (WITH->UU.U10.ips != NULL)
- append(WITH->UU.U15.fps->s, LINK);
- else
- append("(func)", LINK);
- args(&V);
- break;
-
- case ne_itor:
- case ne_rbool:
- case ne_sbool:
- uncompile(WITH->UU.U10.p1, prec, LINK);
- break;
-
- case ne_iarg:
- sprintf(STR1, "i_arg(%ld)", WITH->UU.i);
- append(STR1, LINK);
- break;
-
- case ne_rarg:
- sprintf(STR1, "r_arg(%ld)", WITH->UU.i);
- append(STR1, LINK);
- break;
-
- case ne_sarg:
- sprintf(STR1, "s_arg(%ld)", WITH->UU.i);
- append(STR1, LINK);
- break;
-
- case ne_ineg:
- case ne_rneg:
- if (neg_prec < prec)
- appendc('(', LINK);
- appendc('-', LINK);
- uncompile(WITH->UU.U10.p1, (int)(neg_prec + 1), LINK);
- if (neg_prec < prec)
- appendc(')', LINK);
- break;
-
- case ne_not:
- if (not_prec < prec)
- appendc('(', LINK);
- appendc('~', LINK);
- uncompile(WITH->UU.U10.p1, (int)(not_prec + 1), LINK);
- if (not_prec < prec)
- appendc(')', LINK);
- break;
-
- case ne_lnot:
- if (lnot_prec < prec)
- appendc('(', LINK);
- appendc('!', LINK);
- uncompile(WITH->UU.U10.p1, (int)(lnot_prec + 1), LINK);
- if (lnot_prec < prec)
- appendc(')', LINK);
- break;
-
- case ne_round:
- func("round", &V);
- break;
-
- case ne_trunc:
- func("trunc", &V);
- break;
-
- case ne_ln:
- func("ln", &V);
- break;
-
- case ne_exp:
- func("exp", &V);
- break;
-
- case ne_iabs:
- case ne_rabs:
- func("abs", &V);
- break;
-
- case ne_sqrt:
- func("sqrt", &V);
- break;
-
- case ne_sin:
- func("sin", &V);
- break;
-
- case ne_cos:
- func("cos", &V);
- break;
-
- case ne_tan:
- func("tan", &V);
- break;
-
- case ne_arctan:
- func("arctan", &V);
- break;
-
- default:
- j = numopersyms;
- while (j >= 1 && (ne_opkind)opers[j - 1].iop != (ne_opkind)WITH->op &&
- (ne_opkind)opers[j - 1].rop != (ne_opkind)WITH->op &&
- (ne_opkind)opers[j - 1].sop != (ne_opkind)WITH->op)
- j--;
- if (opers[j - 1].lprec < prec)
- appendc('(', LINK);
- if (opers[j - 1].lprec == opers[j - 1].rprec)
- uncompile(WITH->UU.U10.p1, opers[j - 1].lprec, LINK);
- else
- uncompile(WITH->UU.U10.p1, opers[j - 1].lprec + 1, LINK);
- LINK->ch = opers[j - 1].name;
- nex2 = WITH->UU.U10.p2;
- switch (LINK->ch)
- {
- case '\001':
- if (LINK->desc->doubleeq)
- append("!=", LINK);
- else
- append("<>", LINK);
- break;
-
- case '\002':
- append("<=", LINK);
- break;
-
- case '\003':
- append(">=", LINK);
- break;
-
- case '\004':
- append("&&", LINK);
- break;
-
- case '\005':
- append("||", LINK);
- break;
-
- case '\006':
- append("<<", LINK);
- break;
-
- case '\007':
- append(">>", LINK);
- break;
-
- case '\b':
- append("!!", LINK);
- break;
-
- case '?':
- appendc(LINK->ch, LINK);
- uncompile(WITH->UU.U10.p2, 0, LINK);
- appendc(':', LINK);
- nex2 = WITH->UU.U10.p3;
- break;
-
- default:
- if (LINK->ch == '=' && LINK->desc->doubleeq)
- appendc(LINK->ch, LINK);
- appendc(LINK->ch, LINK);
- break;
- }
-
- if (opers[j - 1].lprec == opers[j - 1].rprec)
- uncompile(nex2, opers[j - 1].lprec + 1, LINK);
- else
- uncompile(nex2, opers[j - 1].lprec, LINK);
- if (opers[j - 1].lprec < prec)
- appendc(')', LINK);
- break;
- }
-}
-
-void ne_uncompile(ne_nexrec *nex, char *ex_, ne_desc *desc_)
-{
- struct LOC_ne_uncompile V;
-
- V.ex = ex_;
- V.desc = desc_;
- V.desc->error = (unsigned)ne_noerror;
- *V.ex = '\0';
- if (nex == NULL)
- {
- append("(nil)", &V);
- return;
- }
- uncompile(nex, 0, &V);
- if (*V.desc->units != '\0' && (unsigned long)V.lastop < 32 &&
- ((1L << ((long)V.lastop)) & ((1L << ((long)ne_ic)) | (1L << ((long)ne_rc)))) != 0)
- append(V.desc->units, &V);
-}
-
-
-#define framesize 4 /*for na_outeralloc*/
-
-static void evalargs(ne_nexrec *nex)
-{
- long i;
- char buf[256];
- long FORLIM;
-
- na_outeralloc((void* *)(&ne_argarray), nex->nargs * 8L, (long)framesize);
- FORLIM = nex->nargs;
- for (i = 0; i < FORLIM; i++)
- {
- if (nex->UU.U15.fp->nargs == 0)
- ne_argarray[i].r = ne_reval(nex->UU.U99.pvals[i]);
- else {
- switch (nex->UU.U15.fp->UU.U99.ptypes[P_imin2(i + 1, (long)nex->UU.U15.fp->nargs) - 1])
- {
-
- case ne_integer:
- case ne_boolean:
- ne_argarray[i].U1.i1 = ne_ieval(nex->UU.U99.pvals[i]);
- break;
-
- case ne_real:
- ne_argarray[i].r = ne_reval(nex->UU.U99.pvals[i]);
- break;
-
- case ne_string:
- ne_seval(buf, nex->UU.U99.pvals[i]);
- na_outeralloc((void* *)(&ne_argarray[i].U16.sp1), strlen(buf) + 1L, (long)framesize);
- strcpy(ne_argarray[i].U16.sp1, buf);
- break;
-
- default:
- break;
- }
- }
- }
-}
-
-#undef framesize
-
-int ne_condeval(ne_nexrec *nex)
-{
- int Result = -1;
-
- TRY(try2);
- Result = (ne_ieval(nex) != 0);
- RECOVER(try2);
- if (P_escapecode == ne_badescape)
- return false;
- else
- _Escape(P_escapecode);
- ENDTRY(try2);
- return Result;
-}
-
-long ne_ieval(ne_nexrec *nex)
-{
- long Result, i1;
- na_quadword *saveargarr;
- ne_nexrec *WITH;
- char STR1[256], STR2[256];
-
- WITH = nex;
- switch ((ne_opkind)nex->op)
- {
- case ne_ic:
- Result = WITH->UU.i;
- break;
-
- case ne_ip:
- Result = *WITH->UU.U10.ip;
- break;
-
- case ne_if:
- if (WITH->UU.U15.fp->subnex)
- {
- saveargarr = ne_argarray;
- TRY(try3);
- evalargs(nex);
- switch ((int)types[(*WITH->UU.U15.fp->UU.nexp)->op])
- {
-
- case ne_integer:
- Result = ne_ieval(*WITH->UU.U15.fp->UU.nexp);
- break;
-
- case ne_real: /*in case of $range off$*/
- Result = (long)floor(ne_reval(*WITH->UU.U15.fp->UU.nexp) + 0.5);
- break;
-
- default:
- P_escapecode = -9;
- goto _Ltry3;
- break;
- }
- ne_argarray = saveargarr;
- RECOVER2(try3,_Ltry3);
- ne_argarray = saveargarr;
- _Escape(P_escapecode);
- ENDTRY(try3);
- }
- else
- {
- if (WITH->UU.U15.fp->UU.U5.ipr.link != NULL)
- (*(void(*) (ne_nexrec *nex, long *res, void* _link)) WITH->UU.U15.fp->UU.U5.ipr.proc)(nex, &i1,
- WITH->UU.U15.fp->UU.U5.ipr.link);
- else
- (*(void(*) (ne_nexrec *nex, long *res)) WITH->UU.U15.fp->UU.U5.ipr.proc)(nex, &i1);
- Result = i1;
- }
- break;
-
- case ne_iarg:
- if (ne_argarray == NULL)
- Result = 0;
- else
- Result = ne_argarray[WITH->UU.i - 1].U1.i1;
- break;
-
- case ne_iadd:
- Result = ne_ieval(WITH->UU.U10.p1) + ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_isub:
- Result = ne_ieval(WITH->UU.U10.p1) - ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_imul:
- Result = ne_ieval(WITH->UU.U10.p1) * ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_idiv:
- Result = ne_ieval(WITH->UU.U10.p1) / ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_ineg:
- Result = -ne_ieval(WITH->UU.U10.p1);
- break;
-
- case ne_imod:
- Result = ne_ieval(WITH->UU.U10.p1) % ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_rbool:
- TRY(try4);
- Result = (ne_reval(WITH->UU.U10.p1) != 0);
- RECOVER(try4);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- Result = 0;
- ENDTRY(try4);
- break;
-
- case ne_sbool:
- TRY(try5);
- Result = (*ne_seval(STR1, WITH->UU.U10.p1) != '\0');
- RECOVER(try5);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- Result = 0;
- ENDTRY(try5);
- break;
-
- case ne_ieq:
- Result = (ne_ieval(WITH->UU.U10.p1) == ne_ieval(WITH->UU.U10.p2));
- break;
-
- case ne_ine:
- Result = (ne_ieval(WITH->UU.U10.p1) != ne_ieval(WITH->UU.U10.p2));
- break;
-
- case ne_ilt:
- Result = (ne_ieval(WITH->UU.U10.p1) < ne_ieval(WITH->UU.U10.p2));
- break;
-
- case ne_ile:
- Result = (ne_ieval(WITH->UU.U10.p1) <= ne_ieval(WITH->UU.U10.p2));
- break;
-
- case ne_igt:
- Result = (ne_ieval(WITH->UU.U10.p1) > ne_ieval(WITH->UU.U10.p2));
- break;
-
- case ne_ige:
- Result = (ne_ieval(WITH->UU.U10.p1) >= ne_ieval(WITH->UU.U10.p2));
- break;
-
- case ne_req:
- Result = (ne_reval(WITH->UU.U10.p1) == ne_reval(WITH->UU.U10.p2));
- break;
-
- case ne_rne:
- Result = (ne_reval(WITH->UU.U10.p1) != ne_reval(WITH->UU.U10.p2));
- break;
-
- case ne_rlt:
- Result = (ne_reval(WITH->UU.U10.p1) < ne_reval(WITH->UU.U10.p2));
- break;
-
- case ne_rle:
- Result = (ne_reval(WITH->UU.U10.p1) <= ne_reval(WITH->UU.U10.p2));
- break;
-
- case ne_rgt:
- Result = (ne_reval(WITH->UU.U10.p1) > ne_reval(WITH->UU.U10.p2));
- break;
-
- case ne_rge:
- Result = (ne_reval(WITH->UU.U10.p1) >= ne_reval(WITH->UU.U10.p2));
- break;
-
- case ne_seq:
- Result = (strcmp(ne_seval(STR1, WITH->UU.U10.p1), ne_seval(STR2, WITH->UU.U10.p2)) == 0);
- break;
-
- case ne_sne:
- Result = (strcmp(ne_seval(STR1, WITH->UU.U10.p1), ne_seval(STR2, WITH->UU.U10.p2)) != 0);
- break;
-
- case ne_slt:
- Result = (strcmp(ne_seval(STR1, WITH->UU.U10.p1), ne_seval(STR2, WITH->UU.U10.p2)) < 0);
- break;
-
- case ne_sle:
- Result = (strcmp(ne_seval(STR1, WITH->UU.U10.p1), ne_seval(STR2, WITH->UU.U10.p2)) <= 0);
- break;
-
- case ne_sgt:
- Result = (strcmp(ne_seval(STR1, WITH->UU.U10.p1), ne_seval(STR2, WITH->UU.U10.p2)) > 0);
- break;
-
- case ne_sge:
- Result = (strcmp(ne_seval(STR1, WITH->UU.U10.p1), ne_seval(STR2, WITH->UU.U10.p2)) >= 0);
- break;
-
- case ne_not:
- Result = ~ne_ieval(WITH->UU.U10.p1);
- break;
-
- case ne_and:
- Result = ne_ieval(WITH->UU.U10.p1) & ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_or:
- Result = ne_ieval(WITH->UU.U10.p1) | ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_xor:
- Result = ne_ieval(WITH->UU.U10.p1) ^ ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_lsh:
- Result = ne_ieval(WITH->UU.U10.p1) << ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_rsh:
- Result = ne_ieval(WITH->UU.U10.p1) >> ne_ieval(WITH->UU.U10.p2);
- break;
-
- case ne_lnot:
- Result = !ne_condeval(WITH->UU.U10.p1);
- break;
-
- case ne_iand:
- if (ne_condeval(WITH->UU.U10.p1))
- Result = ne_ieval(WITH->UU.U10.p2);
- else
- Result = 0;
- break;
-
- case ne_ior:
- TRY(try6);
- i1 = ne_ieval(WITH->UU.U10.p1);
- RECOVER(try6);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- i1 = 0;
- ENDTRY(try6);
- if (i1 == 0)
- Result = ne_ieval(WITH->UU.U10.p2);
- else
- Result = i1;
- break;
-
- case ne_icond:
- if (ne_condeval(WITH->UU.U10.p1))
- Result = ne_ieval(WITH->UU.U10.p2);
- else
- Result = ne_ieval(WITH->UU.U10.p3);
- break;
-
- case ne_round:
- Result = (long)floor(ne_reval(WITH->UU.U10.p1) + 0.5);
- break;
-
- case ne_trunc:
- Result = (long)ne_reval(WITH->UU.U10.p1);
- break;
-
- case ne_iabs:
- Result = labs(ne_ieval(WITH->UU.U10.p1));
- break;
-
- default:
- _Escape(-9);
- break;
- }
- return Result;
-}
-
-
-double ne_reval(ne_nexrec *nex)
-{
- double Result, r1;
- na_quadword *saveargarr;
- ne_nexrec *WITH;
-
- WITH = nex;
- switch ((ne_opkind)nex->op)
- {
-
- case ne_rc:
- Result = WITH->UU.r;
- break;
-
- case ne_rp:
- Result = *WITH->UU.U11.rp;
- break;
-
- case ne_rxp:
- if (*WITH->UU.U11.rp == ne_badvalue)
- _Escape(ne_badescape);
- Result = *WITH->UU.U11.rp;
- break;
-
- case ne_rf:
- if (WITH->UU.U15.fp->subnex)
- {
- saveargarr = ne_argarray;
- TRY(try7);
- evalargs(nex);
- switch ((int)types[(*WITH->UU.U15.fp->UU.nexp)->op])
- {
-
- case ne_integer:
- Result = ne_ieval(*WITH->UU.U15.fp->UU.nexp);
- break;
-
- case ne_real: /*in case of $range off$*/
- Result = ne_reval(*WITH->UU.U15.fp->UU.nexp);
- break;
-
- default:
- P_escapecode = -9;
- goto _Ltry7;
- break;
- }
- ne_argarray = saveargarr;
- RECOVER2(try7,_Ltry7);
- ne_argarray = saveargarr;
- _Escape(P_escapecode);
- ENDTRY(try7);
- } else
- {
- if (WITH->UU.U15.fp->UU.rpr.link != NULL)
- (*(void(*) (ne_nexrec *nex, double *res, void* _link)) WITH->UU.U15.fp->UU.rpr.proc)(nex, &r1,
- WITH->UU.U15.fp->UU.rpr.link);
- else
- (*(void(*) (ne_nexrec *nex, double *res)) WITH->UU.U15.fp->UU.rpr.proc)(nex, &r1);
- Result = r1;
- }
- break;
-
- case ne_rarg:
- if (ne_argarray == NULL)
- Result = 0.0;
- else
- Result = ne_argarray[WITH->UU.i - 1].r;
- break;
-
- case ne_radd:
- Result = ne_reval(WITH->UU.U10.p1) + ne_reval(WITH->UU.U10.p2);
- break;
-
- case ne_rsub:
- Result = ne_reval(WITH->UU.U10.p1) - ne_reval(WITH->UU.U10.p2);
- break;
-
- case ne_rmul:
- Result = ne_reval(WITH->UU.U10.p1) * ne_reval(WITH->UU.U10.p2);
- break;
-
- case ne_rdiv:
- Result = ne_reval(WITH->UU.U10.p1) / ne_reval(WITH->UU.U10.p2);
- break;
-
- case ne_rneg:
- Result = -ne_reval(WITH->UU.U10.p1);
- break;
-
- case ne_rpow:
- Result = ma_ytox(ne_reval(WITH->UU.U10.p1), ne_reval(WITH->UU.U10.p2));
- break;
-
- case ne_itor:
- Result = ne_ieval(WITH->UU.U10.p1);
- break;
-
- case ne_ln:
- Result = log(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_exp:
- Result = exp(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_rabs:
- Result = fabs(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_sqrt:
- Result = sqrt(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_sin:
- Result = sin(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_cos:
- Result = cos(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_tan:
- Result = tan(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_arctan:
- Result = atan(ne_reval(WITH->UU.U10.p1));
- break;
-
- case ne_rand:
- TRY(try8);
- r1 = ne_reval(WITH->UU.U10.p1);
- RECOVER(try8);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- r1 = 0.0;
- ENDTRY(try8);
- if (r1 != 0)
- Result = ne_reval(WITH->UU.U10.p2);
- else
- Result = 0.0;
- break;
-
- case ne_ror:
- TRY(try9);
- r1 = ne_reval(WITH->UU.U10.p1);
- RECOVER(try9);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- r1 = 0.0;
- ENDTRY(try9);
- if (r1 == 0)
- Result = ne_reval(WITH->UU.U10.p2);
- else
- Result = r1;
- break;
-
- case ne_rxor:
- TRY(try10);
- Result = ne_reval(WITH->UU.U10.p1);
- RECOVER(try10);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- Result = ne_reval(WITH->UU.U10.p2);
- ENDTRY(try10);
- break;
-
- case ne_rcond:
- if (ne_condeval(WITH->UU.U10.p1))
- Result = ne_reval(WITH->UU.U10.p2);
- else
- Result = ne_reval(WITH->UU.U10.p3);
- break;
-
- default:
- Result = 0;
- _Escape(-9);
- break;
- }
- return Result;
-}
-
-
-char *ne_seval(char *Result, ne_nexrec *nex)
-{
- char s1[256];
- na_quadword *saveargarr;
- ne_nexrec *WITH;
- char STR1[256], STR2[256];
-
- WITH = nex;
- switch ((ne_opkind)nex->op)
- {
-
- case ne_sc:
- strcpy(Result, WITH->UU.s);
- break;
-
- case ne_sp:
- strcpy(Result, *WITH->UU.U12.sp);
- break;
-
- case ne_sf:
- if (WITH->UU.U15.fp->subnex)
- {
- saveargarr = ne_argarray;
- TRY(try11);
- evalargs(nex);
- ne_seval(Result, *WITH->UU.U15.fp->UU.nexp);
- ne_argarray = saveargarr;
- RECOVER(try11);
- ne_argarray = saveargarr; _Escape(P_escapecode);
- ENDTRY(try11);
- }
- else
- {
- if (WITH->UU.U15.fp->UU.spr.link != NULL)
- (*(void(*) (ne_nexrec *nex, char *res, void* _link)) WITH->UU.U15.fp->UU.spr.proc)(nex, s1, WITH->UU.U15.fp->UU.spr.link);
- else
- (*(void(*) (ne_nexrec *nex, char *res))
- WITH->UU.U15.fp->UU.spr.proc)(nex, s1);
- strcpy(Result, s1);
- }
- break;
-
- case ne_sarg:
- if (ne_argarray == NULL)
- strcpy(Result, "");
- else
- strcpy(Result, ne_argarray[WITH->UU.i - 1].U16.sp1);
- break;
-
- case ne_sadd:
- sprintf(Result, "%s%s",
- ne_seval(STR1, WITH->UU.U10.p1), ne_seval(STR2, WITH->UU.U10.p2));
- break;
-
- case ne_sand:
- TRY(try12);
- ne_seval(s1, WITH->UU.U10.p1);
- RECOVER(try12);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- *s1 = '\0';
- ENDTRY(try12);
- if (*s1 != '\0')
- ne_seval(Result, WITH->UU.U10.p2);
- else
- strcpy(Result, "");
- break;
-
- case ne_sor:
- TRY(try13);
- ne_seval(s1, WITH->UU.U10.p1);
- RECOVER(try13);
- if (P_escapecode != ne_badescape)
- _Escape(P_escapecode);
- *s1 = '\0';
- ENDTRY(try13);
- if (*s1 == '\0')
- ne_seval(Result, WITH->UU.U10.p2);
- else
- strcpy(Result, s1);
- break;
-
- case ne_scond:
- if (ne_condeval(WITH->UU.U10.p1))
- ne_seval(Result, WITH->UU.U10.p2);
- else
- ne_seval(Result, WITH->UU.U10.p3);
- break;
-
- default:
- _Escape(-9);
- break;
- }
- return Result;
-}
-
-ne_datatype ne_exprtype(ne_nexrec *nex)
-{
- if (nex == NULL)
- return ne_notype;
- else
- return (types[nex->op]);
-}
-
-void ne_evaluate(ne_nexrec *nex, ne_nexrec *res)
-{
- char STR1[256];
-
- TRY(try14);
- switch ((int)types[nex->op])
- {
- case ne_notype:
- *res = *nex;
- break;
-
- case ne_integer:
- res->op = (unsigned)ne_ic;
- res->UU.i = ne_ieval(nex);
- break;
-
- case ne_real:
- res->op = (unsigned)ne_rc;
- res->UU.r = ne_reval(nex);
- break;
-
- case ne_string:
- res->op = (unsigned)ne_sc;
- res->UU.s = (char *)strdup(ne_seval(STR1, nex));
- break;
- }
- RECOVER(try14);
-
- if (P_escapecode == -20)
- _Escape(P_escapecode);
- res->op = (unsigned)ne_error;
-
- switch (P_escapecode)
- {
-
- case -3:
- res->UU.err = (unsigned)ne_undef;
- break;
-
- case -5:
- res->UU.err = (unsigned)ne_divzero;
- break;
-
- case -7:
- res->UU.err = (unsigned)ne_underflow;
- break;
-
- case ne_badescape:
- res->UU.err = (unsigned)ne_badval;
- break;
-
- default:
- res->UU.err = (unsigned)ne_overflow;
- break;
- }
- ENDTRY(try14);
-}
-
-static void faileval(ne_nexrec *nex, ne_desc *desc, long esc)
-{
- desc->error = (unsigned)ne_noerror;
- if (nex == NULL || (ne_opkind)nex->op != ne_error)
- _Escape((int)esc);
- desc->error = (unsigned)((ne_errorkind)nex->UU.err);
- switch ((ne_errorkind)nex->UU.err) {
-
- case ne_underflow:
- _Escape(-7);
- break;
-
- case ne_divzero:
- _Escape(-5);
- break;
-
- case ne_strlong:
- _Escape(-8);
- break;
-
- default:
- _Escape((int)esc);
- break;
- }
-}
-
-
-long ne_ievaluate(ne_nexrec *nex, ne_desc *desc)
-{
- if (integerp(nex))
- return (ne_ieval(nex));
- if (realp(nex))
- return ((long)floor(ne_reval(nex) + 0.5));
- faileval(nex, desc, -4L);
-
- return 0L; /* should never happen */
-}
-
-
-double ne_revaluate(ne_nexrec *nex, ne_desc *desc)
-{
- if (realp(nex))
- return (ne_reval(nex));
- if (integerp(nex))
- return (ne_ieval(nex));
- faileval(nex, desc, -6L);
-
- return 0.0; /* should never happen */
-}
-
-char *ne_sevaluate(char *Result, ne_nexrec *nex, ne_desc *desc)
-{
- if (stringp(nex))
- return (ne_seval(Result, nex));
- faileval(nex, desc, -8L);
- return Result;
-}
-
-long ne_ievalexpr(char *ex, ne_desc *desc)
-{
- long Result;
- ne_nexrec *nex;
- long esc;
-
- ne_compile(ex, &nex, desc);
- TRY(try15);
- Result = ne_ievaluate(nex, desc);
- ne_dispose(&nex);
- RECOVER(try15);
- esc = P_escapecode;
- ne_dispose(&nex);
- _Escape((int)esc);
- ENDTRY(try15);
- return Result;
-}
-
-double ne_revalexpr(char *ex, ne_desc *desc)
-{
- double Result;
- ne_nexrec *nex;
- long esc;
-
- ne_compile(ex, &nex, desc);
- TRY(try16);
- Result = ne_revaluate(nex, desc);
- ne_dispose(&nex);
- RECOVER(try16);
- esc = P_escapecode;
- ne_dispose(&nex);
- _Escape((int)esc);
- ENDTRY(try16);
- return Result;
-}
-
-char *ne_sevalexpr(char *Result, char *ex, ne_desc *desc)
-{
- ne_nexrec *nex;
- long esc;
-
- ne_compile(ex, &nex, desc);
- TRY(try17);
- ne_sevaluate(Result, nex, desc);
- ne_dispose(&nex);
- RECOVER(try17);
- esc = P_escapecode;
- ne_dispose(&nex);
- _Escape((int)esc);
- ENDTRY(try17);
-
- return Result;
-}
-
-
-void ne_makeintconst(strlist_t *sym, long i)
-{
- sym->kind = ne_kind_intconst;
- sym->value = (na_long)i;
-}
-
-void ne_makesrealconst(strlist_t *sym, double r)
-{
- sym->kind = ne_kind_srealconst;
- sym->value = na_rtosr(r);
-}
-
-void ne_makerealconst(strlist_t *sym, double r)
-{
- double *rp;
-
- sym->kind = ne_kind_realconst;
- rp = (double *)Malloc(sizeof(double));
- *rp = r;
- sym->value = (void*)rp;
-}
-
-
-void ne_makestrconst(strlist_t *sym, char *s)
-{
- sym->kind = ne_kind_strconst;
- *(char **)((char **)(&sym->value)) = (char *)strdup(s);
-}
-
-void ne_makeintvar(strlist_t *sym, long *i)
-{
- sym->kind = ne_kind_intptr;
- sym->value = (void*)i;
-}
-
-void ne_makerealvar(strlist_t *sym, double *r)
-{
- sym->kind = ne_kind_realptr;
- sym->value = (void*)r;
-}
-
-void ne_makerealxvar(strlist_t *sym, double *r)
-{
- sym->kind = ne_kind_realxptr;
- sym->value = (void*)r;
-}
-
-void ne_makestrvar(strlist_t *sym, char *s)
-{
- sym->kind = ne_kind_strvalue;
- sym->value = (void*)s;
-}
-
-void ne_makestrptrvar(strlist_t *sym, char **sp)
-{
- sym->kind = ne_kind_strptr;
- sym->value = (void*)sp;
-}
-
-static void setupfunc(strlist_t *sym, ne_functionrec **fp, long nargs, ne_datatype *args)
-{
- long i;
-
- *fp = (ne_functionrec *)Malloc(sizeof(ne_functionrec) + nargs * 2);
- (*fp)->nargs = nargs;
- for (i = 0; i < nargs; i++)
- (*fp)->UU.U99.ptypes[i] = args[i];
- (*fp)->static_ = false;
- (*fp)->minargs = nargs;
- (*fp)->maxargs = nargs;
- sym->value = (void*)(*fp);
-}
-
-void ne_makeintmfunc(strlist_t *sym, long nargs, ne_datatype *args, _PROCEDURE pr)
-{
- ne_functionrec *fp;
-
- sym->kind = ne_kind_intfunc;
- setupfunc(sym, &fp, nargs, args);
- fp->subnex = false;
- fp->UU.U5.ipr = pr;
-}
-
-void ne_makerealmfunc(strlist_t *sym, long nargs, ne_datatype *args, _PROCEDURE pr)
-{
- ne_functionrec *fp;
-
- sym->kind = ne_kind_realfunc;
- setupfunc(sym, &fp, nargs, args);
- fp->subnex = false;
- fp->UU.rpr = pr;
-}
-
-void ne_makestrmfunc(strlist_t *sym, long nargs, ne_datatype *args, _PROCEDURE pr)
-{
- ne_functionrec *fp;
-
- sym->kind = ne_kind_strfunc;
- setupfunc(sym, &fp, nargs, args);
- fp->subnex = false;
- fp->UU.spr = pr;
-}
-
-
-void ne_makeintfunc(strlist_t *sym, ne_datatype t1, ne_datatype t2, ne_datatype t3, _PROCEDURE pr)
-{
- ne_datatype args[3];
-
- args[0] = t1;
- args[1] = t2;
- args[2] = t3;
- ne_makeintmfunc(sym, (long)((t1 != ne_notype) + (t2 != ne_notype) + (t3 != ne_notype)), args, pr);
-}
-
-void ne_makerealfunc(strlist_t *sym, ne_datatype t1, ne_datatype t2, ne_datatype t3, _PROCEDURE pr)
-{
- ne_datatype args[3];
-
- args[0] = t1;
- args[1] = t2;
- args[2] = t3;
- ne_makerealmfunc(sym, (long)((t1 != ne_notype) + (t2 != ne_notype) + (t3 != ne_notype)), args, pr);
-}
-
-void ne_makestrfunc(strlist_t *sym, ne_datatype t1, ne_datatype t2, ne_datatype t3, _PROCEDURE pr)
-{
- ne_datatype args[3];
-
- args[0] = t1;
- args[1] = t2;
- args[2] = t3;
- ne_makestrmfunc(sym, (long)((t1 != ne_notype) + (t2 != ne_notype) + (t3 != ne_notype)), args, pr);
-}
-
-void ne_makeintsfunc(strlist_t *sym, long nargs, ne_datatype *args, ne_nexrec **nex)
-{
- ne_functionrec *fp;
-
- sym->kind = ne_kind_intfunc;
- setupfunc(sym, &fp, nargs, args);
- fp->subnex = true;
- fp->UU.nexp = nex;
-}
-
-void ne_makerealsfunc(strlist_t *sym, long nargs, ne_datatype *args, ne_nexrec **nex)
-{
- ne_functionrec *fp;
-
- sym->kind = ne_kind_realfunc;
- setupfunc(sym, &fp, nargs, args);
- fp->subnex = true;
- fp->UU.nexp = nex;
-}
-
-void ne_makestrsfunc(strlist_t *sym, long nargs, ne_datatype *args, ne_nexrec **nex)
-{
- ne_functionrec *fp;
-
- sym->kind = ne_kind_strfunc;
- setupfunc(sym, &fp, nargs, args);
- fp->subnex = true;
- fp->UU.nexp = nex;
-}
-
-void ne_makeintarg(strlist_t *sym, long i)
-{
- sym->kind = ne_kind_intarg;
- sym->value = (na_long)i;
-}
-
-void ne_makerealarg(strlist_t *sym, long i)
-{
- sym->kind = ne_kind_realarg;
- sym->value = (na_long)i;
-}
-
-void ne_makestrarg(strlist_t *sym, long i)
-{
- sym->kind = ne_kind_strarg;
- sym->value = (na_long)i;
-}
-
-void ne_setminargs(strlist_t *sym, long minargs)
-{
- ne_functionrec *fp;
-
- fp = (ne_functionrec *)sym->value;
- fp->minargs = P_imin2((long)fp->nargs, minargs);
-}
-
-void ne_setmaxargs(strlist_t *sym, long maxargs)
-{
- ne_functionrec *fp;
-
- fp = (ne_functionrec *)sym->value;
- fp->maxargs = P_imin2(P_imax2((long)fp->nargs, maxargs), (long)ne_maxargs);
-}
-
-void ne_makestaticfunc(strlist_t *sym)
-{
- ne_functionrec *fp;
-
- fp = (ne_functionrec *)sym->value;
- fp->static_ = true;
-}
-
-void ne_disposesym(strlist_t *sym)
-{
- double *rp;
- ne_functionrec *fp;
-
- switch (sym->kind)
- {
-
- case ne_kind_realconst:
- rp = (double *)sym->value;
- Free(rp);
- break;
-
- case ne_kind_intfunc:
- case ne_kind_realfunc:
- case ne_kind_strfunc:
- fp = (ne_functionrec *)sym->value;
- Free(fp);
- break;
- }
- sym->kind = '\0';
- sym->value = (na_long)0;
-}
-
-void ne_disposesymtab(strlist_t **symtab)
-{
- strlist_t *l1;
-
- l1 = *symtab;
- while (l1 != NULL)
- {
- ne_disposesym(l1);
- l1 = l1->next;
- }
- strlist_empty(symtab);
-}
-
-/* End. */