summaryrefslogtreecommitdiff
path: root/usr/src/lib/libshell/common/sh/streval.c
diff options
context:
space:
mode:
Diffstat (limited to 'usr/src/lib/libshell/common/sh/streval.c')
-rw-r--r--usr/src/lib/libshell/common/sh/streval.c904
1 files changed, 904 insertions, 0 deletions
diff --git a/usr/src/lib/libshell/common/sh/streval.c b/usr/src/lib/libshell/common/sh/streval.c
new file mode 100644
index 0000000000..fd74d47cd6
--- /dev/null
+++ b/usr/src/lib/libshell/common/sh/streval.c
@@ -0,0 +1,904 @@
+/***********************************************************************
+* *
+* This software is part of the ast package *
+* Copyright (c) 1982-2007 AT&T Knowledge Ventures *
+* and is licensed under the *
+* Common Public License, Version 1.0 *
+* by AT&T Knowledge Ventures *
+* *
+* A copy of the License is available at *
+* http://www.opensource.org/licenses/cpl1.0.txt *
+* (with md5 checksum 059e8cd6165cb4c31e351f2b69388fd9) *
+* *
+* Information and Software Systems Research *
+* AT&T Research *
+* Florham Park NJ *
+* *
+* David Korn <dgk@research.att.com> *
+* *
+***********************************************************************/
+#pragma prototyped
+
+/*
+ * D. G. Korn
+ * AT&T Labs
+ *
+ * arithmetic expression evaluator
+ *
+ * this version compiles the expression onto a stack
+ * and has a separate executor
+ */
+
+#include "streval.h"
+#include <ctype.h>
+#include <error.h>
+#include <stak.h>
+#include "FEATURE/externs"
+
+#ifndef ERROR_dictionary
+# define ERROR_dictionary(s) (s)
+#endif
+#ifndef SH_DICT
+# define SH_DICT "libshell"
+#endif
+
+#define MAXLEVEL 9
+#define SMALL_STACK 12
+
+/*
+ * The following are used with tokenbits() macro
+ */
+#define T_OP 0x3f /* mask for operator number */
+#define T_BINARY 0x40 /* binary operators */
+#define T_NOFLOAT 0x80 /* non floating point operator */
+#define A_LVALUE (2*MAXPREC+2)
+
+#define pow2size(x) ((x)<=2?2:(x)<=4?4:(x)<=8?8:(x)<=16?16:(x)<=32?32:64)
+#define round(x,size) (((x)+(size)-1)&~((size)-1))
+#define stakpush(v,val,type) ((((v)->offset=round(staktell(),pow2size(sizeof(type)))),\
+ stakseek((v)->offset+sizeof(type)), \
+ *((type*)stakptr((v)->offset)) = (val)),(v)->offset)
+#define roundptr(ep,cp,type) (((unsigned char*)(ep))+round(cp-((unsigned char*)(ep)),pow2size(sizeof(type))))
+
+static int level;
+
+struct vars /* vars stacked per invocation */
+{
+ const char *expr; /* current expression */
+ const char *nextchr; /* next char in current expression */
+ const char *errchr; /* next char after error */
+ const char *errstr; /* error string */
+ struct lval errmsg; /* error message text */
+ int offset; /* offset for pushchr macro */
+ int staksize; /* current stack size needed */
+ int stakmaxsize; /* maximum stack size needed */
+ unsigned char paren; /* parenthesis level */
+ char infun; /* incremented by comma inside function */
+ int emode;
+ Sfdouble_t (*convert)(const char**,struct lval*,int,Sfdouble_t);
+};
+
+typedef int (*Math_0_f)(Sfdouble_t);
+typedef Sfdouble_t (*Fun_t)(Sfdouble_t,...);
+typedef Sfdouble_t (*Math_1_f)(Sfdouble_t);
+typedef Sfdouble_t (*Math_2_f)(Sfdouble_t,Sfdouble_t);
+typedef Sfdouble_t (*Math_3_f)(Sfdouble_t,Sfdouble_t,Sfdouble_t);
+
+#define getchr(vp) (*(vp)->nextchr++)
+#define peekchr(vp) (*(vp)->nextchr)
+#define ungetchr(vp) ((vp)->nextchr--)
+
+#if ('a'==97) /* ASCII encodings */
+# define getop(c) (((c) >= sizeof(strval_states))? \
+ ((c)=='|'?A_OR:((c)=='^'?A_XOR:((c)=='~'?A_TILDE:A_REG))):\
+ strval_states[(c)])
+#else
+# define getop(c) (isdigit(c)?A_DIG:((c==' '||c=='\t'||c=='\n'||c=='"')?0: \
+ (c=='<'?A_LT:(c=='>'?A_GT:(c=='='?A_ASSIGN: \
+ (c=='+'?A_PLUS:(c=='-'?A_MINUS:(c=='*'?A_TIMES: \
+ (c=='/'?A_DIV:(c=='%'?A_MOD:(c==','?A_COMMA: \
+ (c=='&'?A_AND:(c=='!'?A_NOT:(c=='('?A_LPAR: \
+ (c==')'?A_RPAR:(c==0?A_EOF:(c==':'?A_COLON: \
+ (c=='?'?A_QUEST:(c=='|'?A_OR:(c=='^'?A_XOR: \
+ (c=='\''?A_LIT: \
+ (c=='.'?A_DOT:(c=='~'?A_TILDE:A_REG)))))))))))))))))))))))
+#endif
+
+#define seterror(v,msg) _seterror(v,ERROR_dictionary(msg))
+#define ERROR(vp,msg) return(seterror((vp),msg))
+
+/*
+ * set error message string and return(0)
+ */
+static int _seterror(struct vars *vp,const char *msg)
+{
+ if(!vp->errmsg.value)
+ vp->errmsg.value = (char*)msg;
+ vp->errchr = vp->nextchr;
+ vp->nextchr = "";
+ level = 0;
+ return(0);
+}
+
+
+static void arith_error(const char *message,const char *expr, int mode)
+{
+ level = 0;
+ mode = (mode&3)!=0;
+ errormsg(SH_DICT,ERROR_exit(mode),message,expr);
+}
+
+#if _ast_no_um2fm
+static Sfdouble_t U2F(Sfulong_t u)
+{
+ Sflong_t s = u;
+ Sfdouble_t f;
+
+ if (s >= 0)
+ return s;
+ s = u / 2;
+ f = s;
+ f *= 2;
+ if (u & 1)
+ f++;
+ return f;
+}
+#else
+#define U2F(x) x
+#endif
+
+Sfdouble_t arith_exec(Arith_t *ep)
+{
+ register Sfdouble_t num=0,*dp,*sp;
+ register unsigned char *cp = ep->code;
+ register int c,type=0;
+ register char *tp;
+ Sfdouble_t small_stack[SMALL_STACK+1];
+ const char *ptr = "";
+ Fun_t fun;
+ struct lval node;
+ node.emode = ep->emode;
+ node.expr = ep->expr;
+ node.elen = ep->elen;
+ if(level++ >=MAXLEVEL)
+ {
+ arith_error(e_recursive,ep->expr,ep->emode);
+ return(0);
+ }
+ if(ep->staksize < SMALL_STACK)
+ sp = small_stack;
+ else
+ sp = (Sfdouble_t*)stakalloc(ep->staksize*(sizeof(Sfdouble_t)+1));
+ tp = (char*)(sp+ep->staksize);
+ tp--,sp--;
+ while(c = *cp++)
+ {
+ if(c&T_NOFLOAT)
+ {
+ if(type==1 || ((c&T_BINARY) && (c&T_OP)!=A_MOD && tp[-1]==1))
+ arith_error(e_incompatible,ep->expr,ep->emode);
+ }
+ switch(c&T_OP)
+ {
+ case A_JMP: case A_JMPZ: case A_JMPNZ:
+ c &= T_OP;
+ cp = roundptr(ep,cp,short);
+ if((c==A_JMPZ && num) || (c==A_JMPNZ &&!num))
+ cp += sizeof(short);
+ else
+ cp = (unsigned char*)ep + *((short*)cp);
+ continue;
+ case A_NOTNOT:
+ num = (num!=0);
+ type=0;
+ break;
+ case A_PLUSPLUS:
+ (*ep->fun)(&ptr,&node,ASSIGN,num+1);
+ break;
+ case A_MINUSMINUS:
+ (*ep->fun)(&ptr,&node,ASSIGN,num-1);
+ break;
+ case A_INCR:
+ num = num+1;
+ num = (*ep->fun)(&ptr,&node,ASSIGN,num);
+ break;
+ case A_DECR:
+ num = num-1;
+ num = (*ep->fun)(&ptr,&node,ASSIGN,num);
+ break;
+ case A_SWAP:
+ num = sp[-1];
+ sp[-1] = *sp;
+ type = tp[-1];
+ tp[-1] = *tp;
+ break;
+ case A_POP:
+ sp--;
+ continue;
+ case A_PUSHV:
+ cp = roundptr(ep,cp,Sfdouble_t*);
+ dp = *((Sfdouble_t**)cp);
+ cp += sizeof(Sfdouble_t*);
+ c = *(short*)cp;
+ cp += sizeof(short);
+ node.value = (char*)dp;
+ node.flag = c;
+ node.isfloat=0;
+ node.level = level;
+ num = (*ep->fun)(&ptr,&node,VALUE,num);
+ if(node.value != (char*)dp)
+ arith_error(node.value,ptr,ep->emode);
+ *++sp = num;
+ type = node.isfloat;
+ if(num > LDBL_ULLONG_MAX || num < LDBL_LLONG_MIN)
+ type = 1;
+ else
+ {
+ Sfdouble_t d=num;
+ if(num > LDBL_LLONG_MAX && num <= LDBL_ULLONG_MAX)
+ {
+ type = 2;
+ d -= LDBL_LLONG_MAX;
+ }
+ if((Sflong_t)d!=d)
+ type = 1;
+ }
+ *++tp = type;
+ c = 0;
+ break;
+ case A_STORE:
+ cp = roundptr(ep,cp,Sfdouble_t*);
+ dp = *((Sfdouble_t**)cp);
+ cp += sizeof(Sfdouble_t*);
+ c = *(short*)cp;
+ if(c<0)
+ c = 0;
+ cp += sizeof(short);
+ node.value = (char*)dp;
+ node.flag = c;
+ num = (*ep->fun)(&ptr,&node,ASSIGN,num);
+ break;
+ case A_PUSHF:
+ cp = roundptr(ep,cp,Fun_t);
+ *++sp = (Sfdouble_t)(cp-ep->code);
+ cp += sizeof(Fun_t);
+ *++tp = *cp++;
+ continue;
+ case A_PUSHN:
+ cp = roundptr(ep,cp,Sfdouble_t);
+ num = *((Sfdouble_t*)cp);
+ cp += sizeof(Sfdouble_t);
+ *++sp = num;
+ *++tp = type = *cp++;
+ break;
+ case A_NOT:
+ type=0;
+ num = !num;
+ break;
+ case A_UMINUS:
+ num = -num;
+ break;
+ case A_TILDE:
+ num = ~((Sflong_t)(num));
+ break;
+ case A_PLUS:
+ num += sp[-1];
+ break;
+ case A_MINUS:
+ num = sp[-1] - num;
+ break;
+ case A_TIMES:
+ num *= sp[-1];
+ break;
+ case A_POW:
+ num = pow(sp[-1],num);
+ break;
+ case A_MOD:
+ if(!(Sflong_t)num)
+ arith_error(e_divzero,ep->expr,ep->emode);
+ if(type==2 || tp[-1]==2)
+ num = U2F((Sfulong_t)(sp[-1]) % (Sfulong_t)(num));
+ else
+ num = (Sflong_t)(sp[-1]) % (Sflong_t)(num);
+ break;
+ case A_DIV:
+ if(type==1 || tp[-1]==1)
+ {
+ num = sp[-1]/num;
+ type = 1;
+ }
+ else if((Sfulong_t)(num)==0)
+ arith_error(e_divzero,ep->expr,ep->emode);
+ else if(type==2 || tp[-1]==2)
+ num = U2F((Sfulong_t)(sp[-1]) / (Sfulong_t)(num));
+ else
+ num = (Sflong_t)(sp[-1]) / (Sflong_t)(num);
+ break;
+ case A_LSHIFT:
+ if(tp[-1]==2)
+ num = U2F((Sfulong_t)(sp[-1]) << (long)(num));
+ else
+ num = (Sflong_t)(sp[-1]) << (long)(num);
+ break;
+ case A_RSHIFT:
+ if(tp[-1]==2)
+ num = U2F((Sfulong_t)(sp[-1]) >> (long)(num));
+ else
+ num = (Sflong_t)(sp[-1]) >> (long)(num);
+ break;
+ case A_XOR:
+ if(type==2 || tp[-1]==2)
+ num = U2F((Sfulong_t)(sp[-1]) ^ (Sfulong_t)(num));
+ else
+ num = (Sflong_t)(sp[-1]) ^ (Sflong_t)(num);
+ break;
+ case A_OR:
+ if(type==2 || tp[-1]==2)
+ num = U2F((Sfulong_t)(sp[-1]) | (Sfulong_t)(num));
+ else
+ num = (Sflong_t)(sp[-1]) | (Sflong_t)(num);
+ break;
+ case A_AND:
+ if(type==2 || tp[-1]==2)
+ num = U2F((Sfulong_t)(sp[-1]) & (Sfulong_t)(num));
+ else
+ num = (Sflong_t)(sp[-1]) & (Sflong_t)(num);
+ break;
+ case A_EQ:
+ num = (sp[-1]==num);
+ type=0;
+ break;
+ case A_NEQ:
+ num = (sp[-1]!=num);
+ type=0;
+ break;
+ case A_LE:
+ num = (sp[-1]<=num);
+ type=0;
+ break;
+ case A_GE:
+ num = (sp[-1]>=num);
+ type=0;
+ break;
+ case A_GT:
+ num = (sp[-1]>num);
+ type=0;
+ break;
+ case A_LT:
+ num = (sp[-1]<num);
+ type=0;
+ break;
+ case A_CALL0:
+ sp--,tp--;
+ fun = *((Fun_t*)(ep->code+(int)(*sp)));
+ type = 0;
+ num = (*((Math_0_f)fun))(num);
+ break;
+ case A_CALL1:
+ sp--,tp--;
+ fun = *((Fun_t*)(ep->code+(int)(*sp)));
+ type = *tp;
+ num = (*fun)(num);
+ break;
+ case A_CALL2:
+ sp-=2,tp-=2;
+ fun = *((Fun_t*)(ep->code+(int)(*sp)));
+ type = *tp;
+ num = (*((Math_2_f)fun))(sp[1],num);
+ break;
+ case A_CALL3:
+ sp-=3,tp-=3;
+ fun = *((Fun_t*)(ep->code+(int)(*sp)));
+ type = *tp;
+ num = (*((Math_3_f)fun))(sp[1],sp[2],num);
+ break;
+ }
+ if(c&T_BINARY)
+ sp--,tp--;
+ *sp = num;
+ *tp = type;
+ }
+ if(level>0)
+ level--;
+ return(num);
+}
+
+/*
+ * This returns operator tokens or A_REG or A_NUM
+ */
+static int gettok(register struct vars *vp)
+{
+ register int c,op;
+ vp->errchr = vp->nextchr;
+ while(1)
+ {
+ c = getchr(vp);
+ switch(op=getop(c))
+ {
+ case 0:
+ vp->errchr = vp->nextchr;
+ continue;
+ case A_EOF:
+ vp->nextchr--;
+ break;
+ /*FALL THRU*/
+ case A_DIG: case A_REG: case A_DOT: case A_LIT:
+ if(op==A_DOT)
+ {
+ if((c=peekchr(vp))>='0' && c<='9')
+ op = A_DIG;
+ else
+ op = A_REG;
+ }
+ ungetchr(vp);
+ break;
+ case A_QUEST:
+ if(peekchr(vp)==':')
+ {
+ getchr(vp);
+ op = A_QCOLON;
+ }
+ break;
+ case A_LT: case A_GT:
+ if(peekchr(vp)==c)
+ {
+ getchr(vp);
+ op -= 2;
+ break;
+ }
+ /* FALL THRU */
+ case A_NOT: case A_COLON:
+ c = '=';
+ /* FALL THRU */
+ case A_ASSIGN:
+ case A_TIMES:
+ case A_PLUS: case A_MINUS:
+ case A_OR: case A_AND:
+ if(peekchr(vp)==c)
+ {
+ getchr(vp);
+ op--;
+ }
+ }
+ return(op);
+ }
+}
+
+/*
+ * evaluate a subexpression with precedence
+ */
+
+static int expr(register struct vars *vp,register int precedence)
+{
+ register int c, op;
+ int invalid,wasop=0;
+ struct lval lvalue,assignop;
+ const char *pos;
+ Sfdouble_t d;
+
+ lvalue.value = 0;
+ lvalue.fun = 0;
+again:
+ op = gettok(vp);
+ c = 2*MAXPREC+1;
+ switch(op)
+ {
+ case A_PLUS:
+ goto again;
+ case A_EOF:
+ if(precedence>5)
+ ERROR(vp,e_moretokens);
+ return(1);
+ case A_MINUS:
+ op = A_UMINUS;
+ goto common;
+ case A_NOT:
+ goto common;
+ case A_MINUSMINUS:
+ c = A_LVALUE;
+ op = A_DECR|T_NOFLOAT;
+ goto common;
+ case A_PLUSPLUS:
+ c = A_LVALUE;
+ op = A_INCR|T_NOFLOAT;
+ /* FALL THRU */
+ case A_TILDE:
+ op |= T_NOFLOAT;
+ common:
+ if(!expr(vp,c))
+ return(0);
+ stakputc(op);
+ break;
+ default:
+ vp->nextchr = vp->errchr;
+ wasop = 1;
+ }
+ invalid = wasop;
+ while(1)
+ {
+ assignop.value = 0;
+ op = gettok(vp);
+ if(op==A_DIG || op==A_REG || op==A_LIT)
+ {
+ if(!wasop)
+ ERROR(vp,e_synbad);
+ goto number;
+ }
+ if(wasop++ && op!=A_LPAR)
+ ERROR(vp,e_synbad);
+ /* check for assignment operation */
+ if(peekchr(vp)== '=' && !(strval_precedence[op]&NOASSIGN))
+ {
+ if((!lvalue.value || precedence > 3))
+ ERROR(vp,e_notlvalue);
+ if(precedence==3)
+ precedence = 2;
+ assignop = lvalue;
+ getchr(vp);
+ c = 3;
+ }
+ else
+ {
+ c = (strval_precedence[op]&PRECMASK);
+ if(c==MAXPREC || op==A_POW)
+ c++;
+ c *= 2;
+ }
+ /* from here on c is the new precedence level */
+ if(lvalue.value && (op!=A_ASSIGN))
+ {
+ if(vp->staksize++>=vp->stakmaxsize)
+ vp->stakmaxsize = vp->staksize;
+ stakputc(A_PUSHV);
+ stakpush(vp,lvalue.value,char*);
+ if(lvalue.flag<0)
+ lvalue.flag = 0;
+ stakpush(vp,lvalue.flag,short);
+ if(vp->nextchr==0)
+ ERROR(vp,e_badnum);
+ if(!(strval_precedence[op]&SEQPOINT))
+ lvalue.value = 0;
+ invalid = 0;
+ }
+ else if(precedence==A_LVALUE)
+ ERROR(vp,e_notlvalue);
+ if(invalid && op>A_ASSIGN)
+ ERROR(vp,e_synbad);
+ if(precedence >= c)
+ goto done;
+ if(strval_precedence[op]&RASSOC)
+ c--;
+ if((c < (2*MAXPREC+1)) && !(strval_precedence[op]&SEQPOINT))
+ {
+ wasop = 0;
+ if(!expr(vp,c))
+ return(0);
+ }
+ switch(op)
+ {
+ case A_RPAR:
+ if(!vp->paren)
+ ERROR(vp,e_paren);
+ if(invalid)
+ ERROR(vp,e_synbad);
+ goto done;
+
+ case A_COMMA:
+ wasop = 0;
+ if(vp->infun)
+ vp->infun++;
+ else
+ {
+ stakputc(A_POP);
+ vp->staksize--;
+ }
+ if(!expr(vp,c))
+ return(0);
+ lvalue.value = 0;
+ break;
+
+ case A_LPAR:
+ {
+ int infun = vp->infun;
+ Sfdouble_t (*fun)(Sfdouble_t,...);
+ int nargs = lvalue.nargs;
+ fun = lvalue.fun;
+ lvalue.fun = 0;
+ if(fun)
+ {
+ if(vp->staksize++>=vp->stakmaxsize)
+ vp->stakmaxsize = vp->staksize;
+ vp->infun=1;
+ stakputc(A_PUSHF);
+ stakpush(vp,fun,Fun_t);
+ stakputc(1);
+ }
+ else
+ vp->infun = 0;
+ if(!invalid)
+ ERROR(vp,e_synbad);
+ vp->paren++;
+ if(!expr(vp,1))
+ return(0);
+ vp->paren--;
+ if(fun)
+ {
+ int x= (nargs>7);
+ nargs &= 7;
+ if(vp->infun != nargs)
+ ERROR(vp,e_argcount);
+ if(vp->staksize+=nargs>=vp->stakmaxsize)
+ vp->stakmaxsize = vp->staksize+nargs;
+ stakputc(A_CALL0+nargs -x);
+ vp->staksize -= nargs;
+ }
+ vp->infun = infun;
+ if (gettok(vp) != A_RPAR)
+ ERROR(vp,e_paren);
+ wasop = 0;
+ break;
+ }
+
+ case A_PLUSPLUS:
+ case A_MINUSMINUS:
+ wasop=0;
+ op |= T_NOFLOAT;
+ case A_ASSIGN:
+ if(!lvalue.value)
+ ERROR(vp,e_notlvalue);
+ if(op==A_ASSIGN)
+ {
+ stakputc(A_STORE);
+ stakpush(vp,lvalue.value,char*);
+ stakpush(vp,lvalue.flag,short);
+ vp->staksize--;
+ }
+ else
+ stakputc(op);
+ lvalue.value = 0;
+ break;
+
+ case A_QUEST:
+ {
+ int offset1,offset2;
+ stakputc(A_JMPZ);
+ offset1 = stakpush(vp,0,short);
+ stakputc(A_POP);
+ if(!expr(vp,1))
+ return(0);
+ if(gettok(vp)!=A_COLON)
+ ERROR(vp,e_questcolon);
+ stakputc(A_JMP);
+ offset2 = stakpush(vp,0,short);
+ *((short*)stakptr(offset1)) = staktell();
+ stakputc(A_POP);
+ if(!expr(vp,3))
+ return(0);
+ *((short*)stakptr(offset2)) = staktell();
+ lvalue.value = 0;
+ wasop = 0;
+ break;
+ }
+
+ case A_COLON:
+ ERROR(vp,e_badcolon);
+ break;
+
+ case A_QCOLON:
+ case A_ANDAND:
+ case A_OROR:
+ {
+ int offset;
+ if(op==A_ANDAND)
+ op = A_JMPZ;
+ else
+ op = A_JMPNZ;
+ stakputc(op);
+ offset = stakpush(vp,0,short);
+ stakputc(A_POP);
+ if(!expr(vp,c))
+ return(0);
+ *((short*)stakptr(offset)) = staktell();
+ if(op!=A_QCOLON)
+ stakputc(A_NOTNOT);
+ lvalue.value = 0;
+ wasop=0;
+ break;
+ }
+ case A_AND: case A_OR: case A_XOR: case A_LSHIFT:
+ case A_RSHIFT: case A_MOD:
+ op |= T_NOFLOAT;
+ /* FALL THRU */
+ case A_PLUS: case A_MINUS: case A_TIMES: case A_DIV:
+ case A_EQ: case A_NEQ: case A_LT: case A_LE:
+ case A_GT: case A_GE: case A_POW:
+ stakputc(op|T_BINARY);
+ vp->staksize--;
+ break;
+ case A_NOT: case A_TILDE:
+ default:
+ ERROR(vp,e_synbad);
+ number:
+ wasop = 0;
+ if(*vp->nextchr=='L' && vp->nextchr[1]=='\'')
+ {
+ vp->nextchr++;
+ op = A_LIT;
+ }
+ pos = vp->nextchr;
+ lvalue.isfloat = 0;
+ lvalue.expr = vp->expr;
+ lvalue.emode = vp->emode;
+ if(op==A_LIT)
+ {
+ /* character constants */
+ if(pos[1]=='\\' && pos[2]=='\'' && pos[3]!='\'')
+ {
+ d = '\\';
+ vp->nextchr +=2;
+ }
+ else
+ d = chresc(pos+1,(char**)&vp->nextchr);
+ /* posix allows the trailing ' to be optional */
+ if(*vp->nextchr=='\'')
+ vp->nextchr++;
+ }
+ else
+ d = (*vp->convert)(&vp->nextchr, &lvalue, LOOKUP, 0);
+ if (vp->nextchr == pos)
+ {
+ if(vp->errmsg.value = lvalue.value)
+ vp->errstr = pos;
+ ERROR(vp,op==A_LIT?e_charconst:e_synbad);
+ }
+ if(op==A_DIG || op==A_LIT)
+ {
+ stakputc(A_PUSHN);
+ if(vp->staksize++>=vp->stakmaxsize)
+ vp->stakmaxsize = vp->staksize;
+ stakpush(vp,d,Sfdouble_t);
+ stakputc(lvalue.isfloat);
+ }
+
+ /* check for function call */
+ if(lvalue.fun)
+ continue;
+ break;
+ }
+ invalid = 0;
+ if(assignop.value)
+ {
+ if(vp->staksize++>=vp->stakmaxsize)
+ vp->stakmaxsize = vp->staksize;
+ if(assignop.flag<0)
+ assignop.flag = 0;
+ stakputc(A_STORE);
+ stakpush(vp,assignop.value,char*);
+ stakpush(vp,assignop.flag,short);
+ }
+ }
+ done:
+ vp->nextchr = vp->errchr;
+ return(1);
+}
+
+Arith_t *arith_compile(const char *string,char **last,Sfdouble_t(*fun)(const char**,struct lval*,int,Sfdouble_t),int emode)
+{
+ struct vars cur;
+ register Arith_t *ep;
+ int offset;
+ memset((void*)&cur,0,sizeof(cur));
+ cur.emode = emode;
+ cur.expr = cur.nextchr = string;
+ cur.convert = fun;
+ cur.emode = emode;
+ cur.errmsg.value = 0;
+ cur.errmsg.emode = emode;
+ stakseek(sizeof(Arith_t));
+ if(!expr(&cur,0) && cur.errmsg.value)
+ {
+ if(cur.errstr)
+ string = cur.errstr;
+ (*fun)( &string , &cur.errmsg, MESSAGE, 0);
+ cur.nextchr = cur.errchr;
+ }
+ stakputc(0);
+ offset = staktell();
+ ep = (Arith_t*)stakfreeze(0);
+ ep->expr = string;
+ ep->elen = strlen(string);
+ ep->code = (unsigned char*)(ep+1);
+ ep->fun = fun;
+ ep->emode = emode;
+ ep->size = offset - sizeof(Arith_t);
+ ep->staksize = cur.stakmaxsize+1;
+ if(last)
+ *last = (char*)(cur.nextchr);
+ return(ep);
+}
+
+/*
+ * evaluate an integer arithmetic expression in s
+ *
+ * (Sfdouble_t)(*convert)(char** end, struct lval* string, int type, Sfdouble_t value)
+ * is a user supplied conversion routine that is called when unknown
+ * chars are encountered.
+ * *end points to the part to be converted and must be adjusted by convert to
+ * point to the next non-converted character; if typ is MESSAGE then string
+ * points to an error message string
+ *
+ * NOTE: (*convert)() may call strval()
+ */
+
+Sfdouble_t strval(const char *s,char **end,Sfdouble_t(*conv)(const char**,struct lval*,int,Sfdouble_t),int emode)
+{
+ Arith_t *ep;
+ Sfdouble_t d;
+ char *sp=0;
+ int offset;
+ if(offset=staktell())
+ sp = stakfreeze(1);
+ ep = arith_compile(s,end,conv,emode);
+ ep->emode = emode;
+ d = arith_exec(ep);
+ stakset(sp?sp:(char*)ep,offset);
+ return(d);
+}
+
+#if _mem_name__exception
+#undef _mem_name_exception
+#define _mem_name_exception 1
+#undef exception
+#define exception _exception
+#undef matherr
+#endif
+
+#if _mem_name_exception
+
+#undef error
+
+#if _BLD_shell && defined(__EXPORT__)
+#define extern __EXPORT__
+#endif
+
+#ifndef DOMAIN
+#define DOMAIN _DOMAIN
+#endif
+#ifndef OVERFLOW
+#define OVERFLOW _OVERFLOW
+#endif
+#ifndef SING
+#define SING _SING
+#endif
+
+ extern int matherr(struct exception *ep)
+ {
+ const char *message;
+ switch(ep->type)
+ {
+#ifdef DOMAIN
+ case DOMAIN:
+ message = ERROR_dictionary(e_domain);
+ break;
+#endif
+#ifdef OVERFLOW
+ case OVERFLOW:
+ message = ERROR_dictionary(e_overflow);
+ break;
+#endif
+#ifdef SING
+ case SING:
+ message = ERROR_dictionary(e_singularity);
+ break;
+#endif
+ default:
+ return(1);
+ }
+ level=0;
+ errormsg(SH_DICT,ERROR_exit(1),message,ep->name);
+ return(0);
+ }
+
+#undef extern
+
+#endif /* _mem_name_exception */