xref: /titanic_50/usr/src/lib/libshell/common/sh/streval.c (revision 6075882998740edfaff4dd844974e188f8bd6793)
1 /***********************************************************************
2 *                                                                      *
3 *               This software is part of the ast package               *
4 *           Copyright (c) 1982-2007 AT&T Knowledge Ventures            *
5 *                      and is licensed under the                       *
6 *                  Common Public License, Version 1.0                  *
7 *                      by AT&T Knowledge Ventures                      *
8 *                                                                      *
9 *                A copy of the License is available at                 *
10 *            http://www.opensource.org/licenses/cpl1.0.txt             *
11 *         (with md5 checksum 059e8cd6165cb4c31e351f2b69388fd9)         *
12 *                                                                      *
13 *              Information and Software Systems Research               *
14 *                            AT&T Research                             *
15 *                           Florham Park NJ                            *
16 *                                                                      *
17 *                  David Korn <dgk@research.att.com>                   *
18 *                                                                      *
19 ***********************************************************************/
20 #pragma prototyped
21 
22 /*
23  * D. G. Korn
24  * AT&T Labs
25  *
26  * arithmetic expression evaluator
27  *
28  * this version compiles the expression onto a stack
29  *	 and has a separate executor
30  */
31 
32 #include	"streval.h"
33 #include	<ctype.h>
34 #include	<error.h>
35 #include	<stak.h>
36 #include	"FEATURE/externs"
37 
38 #ifndef ERROR_dictionary
39 #   define ERROR_dictionary(s)	(s)
40 #endif
41 #ifndef SH_DICT
42 #   define SH_DICT	"libshell"
43 #endif
44 
45 #define MAXLEVEL	9
46 #define SMALL_STACK	12
47 
48 /*
49  * The following are used with tokenbits() macro
50  */
51 #define T_OP		0x3f		/* mask for operator number */
52 #define T_BINARY	0x40		/* binary operators */
53 #define T_NOFLOAT	0x80		/* non floating point operator */
54 #define A_LVALUE	(2*MAXPREC+2)
55 
56 #define pow2size(x)		((x)<=2?2:(x)<=4?4:(x)<=8?8:(x)<=16?16:(x)<=32?32:64)
57 #define round(x,size)		(((x)+(size)-1)&~((size)-1))
58 #define stakpush(v,val,type)	((((v)->offset=round(staktell(),pow2size(sizeof(type)))),\
59 				stakseek((v)->offset+sizeof(type)), \
60 				*((type*)stakptr((v)->offset)) = (val)),(v)->offset)
61 #define roundptr(ep,cp,type)	(((unsigned char*)(ep))+round(cp-((unsigned char*)(ep)),pow2size(sizeof(type))))
62 
63 static int level;
64 
65 struct vars				/* vars stacked per invocation */
66 {
67 	const char	*expr;		/* current expression */
68 	const char	*nextchr;	/* next char in current expression */
69 	const char	*errchr; 	/* next char after error	*/
70 	const char	*errstr;	/* error string			*/
71 	struct lval	errmsg;	 	/* error message text		*/
72 	int		offset;		/* offset for pushchr macro	*/
73 	int		staksize;	/* current stack size needed	*/
74 	int		stakmaxsize;	/* maximum stack size needed	*/
75 	unsigned char	paren;	 	/* parenthesis level		*/
76 	char		infun;	/* incremented by comma inside function	*/
77 	int		emode;
78 	Sfdouble_t	(*convert)(const char**,struct lval*,int,Sfdouble_t);
79 };
80 
81 typedef int	   (*Math_0_f)(Sfdouble_t);
82 typedef Sfdouble_t (*Fun_t)(Sfdouble_t,...);
83 typedef Sfdouble_t (*Math_1_f)(Sfdouble_t);
84 typedef Sfdouble_t (*Math_2_f)(Sfdouble_t,Sfdouble_t);
85 typedef Sfdouble_t (*Math_3_f)(Sfdouble_t,Sfdouble_t,Sfdouble_t);
86 
87 #define getchr(vp)	(*(vp)->nextchr++)
88 #define peekchr(vp)	(*(vp)->nextchr)
89 #define ungetchr(vp)	((vp)->nextchr--)
90 
91 #if ('a'==97)	/* ASCII encodings */
92 #   define getop(c)	(((c) >= sizeof(strval_states))? \
93 				((c)=='|'?A_OR:((c)=='^'?A_XOR:((c)=='~'?A_TILDE:A_REG))):\
94 				strval_states[(c)])
95 #else
96 #   define getop(c)	(isdigit(c)?A_DIG:((c==' '||c=='\t'||c=='\n'||c=='"')?0: \
97 			(c=='<'?A_LT:(c=='>'?A_GT:(c=='='?A_ASSIGN: \
98 			(c=='+'?A_PLUS:(c=='-'?A_MINUS:(c=='*'?A_TIMES: \
99 			(c=='/'?A_DIV:(c=='%'?A_MOD:(c==','?A_COMMA: \
100 			(c=='&'?A_AND:(c=='!'?A_NOT:(c=='('?A_LPAR: \
101 			(c==')'?A_RPAR:(c==0?A_EOF:(c==':'?A_COLON: \
102 			(c=='?'?A_QUEST:(c=='|'?A_OR:(c=='^'?A_XOR: \
103 			(c=='\''?A_LIT: \
104 			(c=='.'?A_DOT:(c=='~'?A_TILDE:A_REG)))))))))))))))))))))))
105 #endif
106 
107 #define seterror(v,msg)		_seterror(v,ERROR_dictionary(msg))
108 #define ERROR(vp,msg)		return(seterror((vp),msg))
109 
110 /*
111  * set error message string and return(0)
112  */
113 static int _seterror(struct vars *vp,const char *msg)
114 {
115 	if(!vp->errmsg.value)
116 		vp->errmsg.value = (char*)msg;
117 	vp->errchr = vp->nextchr;
118 	vp->nextchr = "";
119 	level = 0;
120 	return(0);
121 }
122 
123 
124 static void arith_error(const char *message,const char *expr, int mode)
125 {
126         level = 0;
127 	mode = (mode&3)!=0;
128         errormsg(SH_DICT,ERROR_exit(mode),message,expr);
129 }
130 
131 #if _ast_no_um2fm
132 static Sfdouble_t U2F(Sfulong_t u)
133 {
134 	Sflong_t	s = u;
135 	Sfdouble_t	f;
136 
137 	if (s >= 0)
138 		return s;
139 	s = u / 2;
140 	f = s;
141 	f *= 2;
142 	if (u & 1)
143 		f++;
144 	return f;
145 }
146 #else
147 #define U2F(x)		x
148 #endif
149 
150 Sfdouble_t	arith_exec(Arith_t *ep)
151 {
152 	register Sfdouble_t num=0,*dp,*sp;
153 	register unsigned char *cp = ep->code;
154 	register int c,type=0;
155 	register char *tp;
156 	Sfdouble_t small_stack[SMALL_STACK+1];
157 	const char *ptr = "";
158 	Fun_t fun;
159 	struct lval node;
160 	node.emode = ep->emode;
161 	node.expr = ep->expr;
162 	node.elen = ep->elen;
163 	if(level++ >=MAXLEVEL)
164 	{
165 		arith_error(e_recursive,ep->expr,ep->emode);
166 		return(0);
167 	}
168 	if(ep->staksize < SMALL_STACK)
169 		sp = small_stack;
170 	else
171 		sp = (Sfdouble_t*)stakalloc(ep->staksize*(sizeof(Sfdouble_t)+1));
172 	tp = (char*)(sp+ep->staksize);
173 	tp--,sp--;
174 	while(c = *cp++)
175 	{
176 		if(c&T_NOFLOAT)
177 		{
178 			if(type==1 || ((c&T_BINARY) && (c&T_OP)!=A_MOD  && tp[-1]==1))
179 				arith_error(e_incompatible,ep->expr,ep->emode);
180 		}
181 		switch(c&T_OP)
182 		{
183 		    case A_JMP: case A_JMPZ: case A_JMPNZ:
184 			c &= T_OP;
185 			cp = roundptr(ep,cp,short);
186 			if((c==A_JMPZ && num) || (c==A_JMPNZ &&!num))
187 				cp += sizeof(short);
188 			else
189 				cp = (unsigned char*)ep + *((short*)cp);
190 			continue;
191 		    case A_NOTNOT:
192 			num = (num!=0);
193 			type=0;
194 			break;
195 		    case A_PLUSPLUS:
196 			(*ep->fun)(&ptr,&node,ASSIGN,num+1);
197 			break;
198 		    case A_MINUSMINUS:
199 			(*ep->fun)(&ptr,&node,ASSIGN,num-1);
200 			break;
201 		    case A_INCR:
202 			num = num+1;
203 			num = (*ep->fun)(&ptr,&node,ASSIGN,num);
204 			break;
205 		    case A_DECR:
206 			num = num-1;
207 			num = (*ep->fun)(&ptr,&node,ASSIGN,num);
208 			break;
209 		    case A_SWAP:
210 			num = sp[-1];
211 			sp[-1] = *sp;
212 			type = tp[-1];
213 			tp[-1] = *tp;
214 			break;
215 		    case A_POP:
216 			sp--;
217 			continue;
218 		    case A_PUSHV:
219 			cp = roundptr(ep,cp,Sfdouble_t*);
220 			dp = *((Sfdouble_t**)cp);
221 			cp += sizeof(Sfdouble_t*);
222 			c = *(short*)cp;
223 			cp += sizeof(short);
224 			node.value = (char*)dp;
225 			node.flag = c;
226 			node.isfloat=0;
227 			node.level = level;
228 			num = (*ep->fun)(&ptr,&node,VALUE,num);
229 			if(node.value != (char*)dp)
230 				arith_error(node.value,ptr,ep->emode);
231 			*++sp = num;
232 			type = node.isfloat;
233 			if(num > LDBL_ULLONG_MAX || num < LDBL_LLONG_MIN)
234 				type = 1;
235 			else
236 			{
237 				Sfdouble_t d=num;
238 				if(num > LDBL_LLONG_MAX && num <= LDBL_ULLONG_MAX)
239 				{
240 					type = 2;
241 					d -= LDBL_LLONG_MAX;
242 				}
243 				if((Sflong_t)d!=d)
244 					type = 1;
245 			}
246 			*++tp = type;
247 			c = 0;
248 			break;
249 		    case A_STORE:
250 			cp = roundptr(ep,cp,Sfdouble_t*);
251 			dp = *((Sfdouble_t**)cp);
252 			cp += sizeof(Sfdouble_t*);
253 			c = *(short*)cp;
254 			if(c<0)
255 				c = 0;
256 			cp += sizeof(short);
257 			node.value = (char*)dp;
258 			node.flag = c;
259 			num = (*ep->fun)(&ptr,&node,ASSIGN,num);
260 			break;
261 		    case A_PUSHF:
262 			cp = roundptr(ep,cp,Fun_t);
263 			*++sp = (Sfdouble_t)(cp-ep->code);
264 			cp += sizeof(Fun_t);
265 			*++tp = *cp++;
266 			continue;
267 		    case A_PUSHN:
268 			cp = roundptr(ep,cp,Sfdouble_t);
269 			num = *((Sfdouble_t*)cp);
270 			cp += sizeof(Sfdouble_t);
271 			*++sp = num;
272 			*++tp = type = *cp++;
273 			break;
274 		    case A_NOT:
275 			type=0;
276 			num = !num;
277 			break;
278 		    case A_UMINUS:
279 			num = -num;
280 			break;
281 		    case A_TILDE:
282 			num = ~((Sflong_t)(num));
283 			break;
284 		    case A_PLUS:
285 			num += sp[-1];
286 			break;
287 		    case A_MINUS:
288 			num = sp[-1] - num;
289 			break;
290 		    case A_TIMES:
291 			num *= sp[-1];
292 			break;
293 		    case A_POW:
294 			num = pow(sp[-1],num);
295 			break;
296 		    case A_MOD:
297 			if(!(Sflong_t)num)
298 				arith_error(e_divzero,ep->expr,ep->emode);
299 			if(type==2 || tp[-1]==2)
300 				num = U2F((Sfulong_t)(sp[-1]) % (Sfulong_t)(num));
301 			else
302 				num = (Sflong_t)(sp[-1]) % (Sflong_t)(num);
303 			break;
304 		    case A_DIV:
305 			if(type==1 || tp[-1]==1)
306 			{
307 				num = sp[-1]/num;
308 				type = 1;
309 			}
310 			else if((Sfulong_t)(num)==0)
311 				arith_error(e_divzero,ep->expr,ep->emode);
312 			else if(type==2 || tp[-1]==2)
313 				num = U2F((Sfulong_t)(sp[-1]) / (Sfulong_t)(num));
314 			else
315 				num = (Sflong_t)(sp[-1]) / (Sflong_t)(num);
316 			break;
317 		    case A_LSHIFT:
318 			if(tp[-1]==2)
319 				num = U2F((Sfulong_t)(sp[-1]) << (long)(num));
320 			else
321 				num = (Sflong_t)(sp[-1]) << (long)(num);
322 			break;
323 		    case A_RSHIFT:
324 			if(tp[-1]==2)
325 				num = U2F((Sfulong_t)(sp[-1]) >> (long)(num));
326 			else
327 				num = (Sflong_t)(sp[-1]) >> (long)(num);
328 			break;
329 		    case A_XOR:
330 			if(type==2 || tp[-1]==2)
331 				num = U2F((Sfulong_t)(sp[-1]) ^ (Sfulong_t)(num));
332 			else
333 				num = (Sflong_t)(sp[-1]) ^ (Sflong_t)(num);
334 			break;
335 		    case A_OR:
336 			if(type==2 || tp[-1]==2)
337 				num = U2F((Sfulong_t)(sp[-1]) | (Sfulong_t)(num));
338 			else
339 				num = (Sflong_t)(sp[-1]) | (Sflong_t)(num);
340 			break;
341 		    case A_AND:
342 			if(type==2 || tp[-1]==2)
343 				num = U2F((Sfulong_t)(sp[-1]) & (Sfulong_t)(num));
344 			else
345 				num = (Sflong_t)(sp[-1]) & (Sflong_t)(num);
346 			break;
347 		    case A_EQ:
348 			num = (sp[-1]==num);
349 			type=0;
350 			break;
351 		    case A_NEQ:
352 			num = (sp[-1]!=num);
353 			type=0;
354 			break;
355 		    case A_LE:
356 			num = (sp[-1]<=num);
357 			type=0;
358 			break;
359 		    case A_GE:
360 			num = (sp[-1]>=num);
361 			type=0;
362 			break;
363 		    case A_GT:
364 			num = (sp[-1]>num);
365 			type=0;
366 			break;
367 		    case A_LT:
368 			num = (sp[-1]<num);
369 			type=0;
370 			break;
371 		    case A_CALL0:
372 			sp--,tp--;
373 			fun = *((Fun_t*)(ep->code+(int)(*sp)));
374 			type = 0;
375 			num = (*((Math_0_f)fun))(num);
376 			break;
377 		    case A_CALL1:
378 			sp--,tp--;
379 			fun = *((Fun_t*)(ep->code+(int)(*sp)));
380 			type = *tp;
381 			num = (*fun)(num);
382 			break;
383 		    case A_CALL2:
384 			sp-=2,tp-=2;
385 			fun = *((Fun_t*)(ep->code+(int)(*sp)));
386 			type = *tp;
387 			num = (*((Math_2_f)fun))(sp[1],num);
388 			break;
389 		    case A_CALL3:
390 			sp-=3,tp-=3;
391 			fun = *((Fun_t*)(ep->code+(int)(*sp)));
392 			type = *tp;
393 			num = (*((Math_3_f)fun))(sp[1],sp[2],num);
394 			break;
395 		}
396 		if(c&T_BINARY)
397 			sp--,tp--;
398 		*sp = num;
399 		*tp = type;
400 	}
401 	if(level>0)
402 		level--;
403 	return(num);
404 }
405 
406 /*
407  * This returns operator tokens or A_REG or A_NUM
408  */
409 static int gettok(register struct vars *vp)
410 {
411 	register int c,op;
412 	vp->errchr = vp->nextchr;
413 	while(1)
414 	{
415 		c = getchr(vp);
416 		switch(op=getop(c))
417 		{
418 		    case 0:
419 			vp->errchr = vp->nextchr;
420 			continue;
421 		    case A_EOF:
422 			vp->nextchr--;
423 			break;
424 			/*FALL THRU*/
425 		    case A_DIG: case A_REG: case A_DOT: case A_LIT:
426 			if(op==A_DOT)
427 			{
428 				if((c=peekchr(vp))>='0' && c<='9')
429 					op = A_DIG;
430 				else
431 					op = A_REG;
432 			}
433 			ungetchr(vp);
434 			break;
435 		    case A_QUEST:
436 			if(peekchr(vp)==':')
437 			{
438 				getchr(vp);
439 				op = A_QCOLON;
440 			}
441 			break;
442 		    case A_LT:	case A_GT:
443 			if(peekchr(vp)==c)
444 			{
445 				getchr(vp);
446 				op -= 2;
447 				break;
448 			}
449 			/* FALL THRU */
450 		    case A_NOT:	case A_COLON:
451 			c = '=';
452 			/* FALL THRU */
453 		    case A_ASSIGN:
454 		    case A_TIMES:
455 		    case A_PLUS:	case A_MINUS:
456 		    case A_OR:	case A_AND:
457 			if(peekchr(vp)==c)
458 			{
459 				getchr(vp);
460 				op--;
461 			}
462 		}
463 		return(op);
464 	}
465 }
466 
467 /*
468  * evaluate a subexpression with precedence
469  */
470 
471 static int expr(register struct vars *vp,register int precedence)
472 {
473 	register int	c, op;
474 	int		invalid,wasop=0;
475 	struct lval	lvalue,assignop;
476 	const char	*pos;
477 	Sfdouble_t		d;
478 
479 	lvalue.value = 0;
480 	lvalue.fun = 0;
481 again:
482 	op = gettok(vp);
483 	c = 2*MAXPREC+1;
484 	switch(op)
485 	{
486 	    case A_PLUS:
487 		goto again;
488 	    case A_EOF:
489 		if(precedence>5)
490 			ERROR(vp,e_moretokens);
491 		return(1);
492 	    case A_MINUS:
493 		op =  A_UMINUS;
494 		goto common;
495 	    case A_NOT:
496 		goto common;
497 	    case A_MINUSMINUS:
498 		c = A_LVALUE;
499 		op = A_DECR|T_NOFLOAT;
500 		goto common;
501 	    case A_PLUSPLUS:
502 		c = A_LVALUE;
503 		op = A_INCR|T_NOFLOAT;
504 		/* FALL THRU */
505 	    case A_TILDE:
506 		op |= T_NOFLOAT;
507 	    common:
508 		if(!expr(vp,c))
509 			return(0);
510 		stakputc(op);
511 		break;
512 	    default:
513 		vp->nextchr = vp->errchr;
514 		wasop = 1;
515 	}
516 	invalid = wasop;
517 	while(1)
518 	{
519 		assignop.value = 0;
520 		op = gettok(vp);
521 		if(op==A_DIG || op==A_REG || op==A_LIT)
522 		{
523 			if(!wasop)
524 				ERROR(vp,e_synbad);
525 			goto number;
526 		}
527 		if(wasop++ && op!=A_LPAR)
528 			ERROR(vp,e_synbad);
529 		/* check for assignment operation */
530 		if(peekchr(vp)== '=' && !(strval_precedence[op]&NOASSIGN))
531 		{
532 			if((!lvalue.value || precedence > 3))
533 				ERROR(vp,e_notlvalue);
534 			if(precedence==3)
535 				precedence = 2;
536 			assignop = lvalue;
537 			getchr(vp);
538 			c = 3;
539 		}
540 		else
541 		{
542 			c = (strval_precedence[op]&PRECMASK);
543 			if(c==MAXPREC || op==A_POW)
544 				c++;
545 			c *= 2;
546 		}
547 		/* from here on c is the new precedence level */
548 		if(lvalue.value && (op!=A_ASSIGN))
549 		{
550 			if(vp->staksize++>=vp->stakmaxsize)
551 				vp->stakmaxsize = vp->staksize;
552 			stakputc(A_PUSHV);
553 			stakpush(vp,lvalue.value,char*);
554 			if(lvalue.flag<0)
555 				lvalue.flag = 0;
556 			stakpush(vp,lvalue.flag,short);
557 			if(vp->nextchr==0)
558 				ERROR(vp,e_badnum);
559 			if(!(strval_precedence[op]&SEQPOINT))
560 				lvalue.value = 0;
561 			invalid = 0;
562 		}
563 		else if(precedence==A_LVALUE)
564 			ERROR(vp,e_notlvalue);
565 		if(invalid && op>A_ASSIGN)
566 			ERROR(vp,e_synbad);
567 		if(precedence >= c)
568 			goto done;
569 		if(strval_precedence[op]&RASSOC)
570 			c--;
571 		if((c < (2*MAXPREC+1)) && !(strval_precedence[op]&SEQPOINT))
572 		{
573 			wasop = 0;
574 			if(!expr(vp,c))
575 				return(0);
576 		}
577 		switch(op)
578 		{
579 		case A_RPAR:
580 			if(!vp->paren)
581 				ERROR(vp,e_paren);
582 			if(invalid)
583 				ERROR(vp,e_synbad);
584 			goto done;
585 
586 		case A_COMMA:
587 			wasop = 0;
588 			if(vp->infun)
589 				vp->infun++;
590 			else
591 			{
592 				stakputc(A_POP);
593 				vp->staksize--;
594 			}
595 			if(!expr(vp,c))
596 				return(0);
597 			lvalue.value = 0;
598 			break;
599 
600 		case A_LPAR:
601 		{
602 			int	infun = vp->infun;
603 			Sfdouble_t (*fun)(Sfdouble_t,...);
604 			int nargs = lvalue.nargs;
605 			fun = lvalue.fun;
606 			lvalue.fun = 0;
607 			if(fun)
608 			{
609 				if(vp->staksize++>=vp->stakmaxsize)
610 					vp->stakmaxsize = vp->staksize;
611 				vp->infun=1;
612 				stakputc(A_PUSHF);
613 				stakpush(vp,fun,Fun_t);
614 				stakputc(1);
615 			}
616 			else
617 				vp->infun = 0;
618 			if(!invalid)
619 				ERROR(vp,e_synbad);
620 			vp->paren++;
621 			if(!expr(vp,1))
622 				return(0);
623 			vp->paren--;
624 			if(fun)
625 			{
626 				int  x= (nargs>7);
627 				nargs &= 7;
628 				if(vp->infun != nargs)
629 					ERROR(vp,e_argcount);
630 				if(vp->staksize+=nargs>=vp->stakmaxsize)
631 					vp->stakmaxsize = vp->staksize+nargs;
632 				stakputc(A_CALL0+nargs -x);
633 				vp->staksize -= nargs;
634 			}
635 			vp->infun = infun;
636 			if (gettok(vp) != A_RPAR)
637 				ERROR(vp,e_paren);
638 			wasop = 0;
639 			break;
640 		}
641 
642 		case A_PLUSPLUS:
643 		case A_MINUSMINUS:
644 			wasop=0;
645 			op |= T_NOFLOAT;
646 		case A_ASSIGN:
647 			if(!lvalue.value)
648 				ERROR(vp,e_notlvalue);
649 			if(op==A_ASSIGN)
650 			{
651 				stakputc(A_STORE);
652 				stakpush(vp,lvalue.value,char*);
653 				stakpush(vp,lvalue.flag,short);
654 				vp->staksize--;
655 			}
656 			else
657 				stakputc(op);
658 			lvalue.value = 0;
659 			break;
660 
661 		case A_QUEST:
662 		{
663 			int offset1,offset2;
664 			stakputc(A_JMPZ);
665 			offset1 = stakpush(vp,0,short);
666 			stakputc(A_POP);
667 			if(!expr(vp,1))
668 				return(0);
669 			if(gettok(vp)!=A_COLON)
670 				ERROR(vp,e_questcolon);
671 			stakputc(A_JMP);
672 			offset2 = stakpush(vp,0,short);
673 			*((short*)stakptr(offset1)) = staktell();
674 			stakputc(A_POP);
675 			if(!expr(vp,3))
676 				return(0);
677 			*((short*)stakptr(offset2)) = staktell();
678 			lvalue.value = 0;
679 			wasop = 0;
680 			break;
681 		}
682 
683 		case A_COLON:
684 			ERROR(vp,e_badcolon);
685 			break;
686 
687 		case A_QCOLON:
688 		case A_ANDAND:
689 		case A_OROR:
690 		{
691 			int offset;
692 			if(op==A_ANDAND)
693 				op = A_JMPZ;
694 			else
695 				op = A_JMPNZ;
696 			stakputc(op);
697 			offset = stakpush(vp,0,short);
698 			stakputc(A_POP);
699 			if(!expr(vp,c))
700 				return(0);
701 			*((short*)stakptr(offset)) = staktell();
702 			if(op!=A_QCOLON)
703 				stakputc(A_NOTNOT);
704 			lvalue.value = 0;
705 			wasop=0;
706 			break;
707 		}
708 		case A_AND:	case A_OR:	case A_XOR:	case A_LSHIFT:
709 		case A_RSHIFT:	case A_MOD:
710 			op |= T_NOFLOAT;
711 			/* FALL THRU */
712 		case A_PLUS:	case A_MINUS:	case A_TIMES:	case A_DIV:
713 		case A_EQ:	case A_NEQ:	case A_LT:	case A_LE:
714 		case A_GT:	case A_GE:	case A_POW:
715 			stakputc(op|T_BINARY);
716 			vp->staksize--;
717 			break;
718 		case A_NOT: case A_TILDE:
719 		default:
720 			ERROR(vp,e_synbad);
721 		number:
722 			wasop = 0;
723 			if(*vp->nextchr=='L' && vp->nextchr[1]=='\'')
724 			{
725 				vp->nextchr++;
726 				op = A_LIT;
727 			}
728 			pos = vp->nextchr;
729 			lvalue.isfloat = 0;
730 			lvalue.expr = vp->expr;
731 			lvalue.emode = vp->emode;
732 			if(op==A_LIT)
733 			{
734 				/* character constants */
735 				if(pos[1]=='\\' && pos[2]=='\'' && pos[3]!='\'')
736 				{
737 					d = '\\';
738 					vp->nextchr +=2;
739 				}
740 				else
741 					d = chresc(pos+1,(char**)&vp->nextchr);
742 				/* posix allows the trailing ' to be optional */
743 				if(*vp->nextchr=='\'')
744 					vp->nextchr++;
745 			}
746 			else
747 				d = (*vp->convert)(&vp->nextchr, &lvalue, LOOKUP, 0);
748 			if (vp->nextchr == pos)
749 			{
750 				if(vp->errmsg.value = lvalue.value)
751 					vp->errstr = pos;
752 				ERROR(vp,op==A_LIT?e_charconst:e_synbad);
753 			}
754 			if(op==A_DIG || op==A_LIT)
755 			{
756 				stakputc(A_PUSHN);
757 				if(vp->staksize++>=vp->stakmaxsize)
758 					vp->stakmaxsize = vp->staksize;
759 				stakpush(vp,d,Sfdouble_t);
760 				stakputc(lvalue.isfloat);
761 			}
762 
763 			/* check for function call */
764 			if(lvalue.fun)
765 				continue;
766 			break;
767 		}
768 		invalid = 0;
769 		if(assignop.value)
770 		{
771 			if(vp->staksize++>=vp->stakmaxsize)
772 				vp->stakmaxsize = vp->staksize;
773 			if(assignop.flag<0)
774 				assignop.flag = 0;
775 			stakputc(A_STORE);
776 			stakpush(vp,assignop.value,char*);
777 			stakpush(vp,assignop.flag,short);
778 		}
779 	}
780  done:
781 	vp->nextchr = vp->errchr;
782 	return(1);
783 }
784 
785 Arith_t *arith_compile(const char *string,char **last,Sfdouble_t(*fun)(const char**,struct lval*,int,Sfdouble_t),int emode)
786 {
787 	struct vars cur;
788 	register Arith_t *ep;
789 	int offset;
790 	memset((void*)&cur,0,sizeof(cur));
791 	cur.emode = emode;
792      	cur.expr = cur.nextchr = string;
793 	cur.convert = fun;
794 	cur.emode = emode;
795 	cur.errmsg.value = 0;
796 	cur.errmsg.emode = emode;
797 	stakseek(sizeof(Arith_t));
798 	if(!expr(&cur,0) && cur.errmsg.value)
799         {
800 		if(cur.errstr)
801 			string = cur.errstr;
802 		(*fun)( &string , &cur.errmsg, MESSAGE, 0);
803 		cur.nextchr = cur.errchr;
804 	}
805 	stakputc(0);
806 	offset = staktell();
807 	ep = (Arith_t*)stakfreeze(0);
808 	ep->expr = string;
809 	ep->elen = strlen(string);
810 	ep->code = (unsigned char*)(ep+1);
811 	ep->fun = fun;
812 	ep->emode = emode;
813 	ep->size = offset - sizeof(Arith_t);
814 	ep->staksize = cur.stakmaxsize+1;
815 	if(last)
816 		*last = (char*)(cur.nextchr);
817 	return(ep);
818 }
819 
820 /*
821  * evaluate an integer arithmetic expression in s
822  *
823  * (Sfdouble_t)(*convert)(char** end, struct lval* string, int type, Sfdouble_t value)
824  *     is a user supplied conversion routine that is called when unknown
825  *     chars are encountered.
826  * *end points to the part to be converted and must be adjusted by convert to
827  * point to the next non-converted character; if typ is MESSAGE then string
828  * points to an error message string
829  *
830  * NOTE: (*convert)() may call strval()
831  */
832 
833 Sfdouble_t strval(const char *s,char **end,Sfdouble_t(*conv)(const char**,struct lval*,int,Sfdouble_t),int emode)
834 {
835 	Arith_t *ep;
836 	Sfdouble_t d;
837 	char *sp=0;
838 	int offset;
839 	if(offset=staktell())
840 		sp = stakfreeze(1);
841 	ep = arith_compile(s,end,conv,emode);
842 	ep->emode = emode;
843 	d = arith_exec(ep);
844 	stakset(sp?sp:(char*)ep,offset);
845 	return(d);
846 }
847 
848 #if _mem_name__exception
849 #undef	_mem_name_exception
850 #define	_mem_name_exception	1
851 #undef	exception
852 #define	exception		_exception
853 #undef	matherr
854 #endif
855 
856 #if _mem_name_exception
857 
858 #undef	error
859 
860 #if _BLD_shell && defined(__EXPORT__)
861 #define extern			__EXPORT__
862 #endif
863 
864 #ifndef DOMAIN
865 #define DOMAIN			_DOMAIN
866 #endif
867 #ifndef OVERFLOW
868 #define OVERFLOW		_OVERFLOW
869 #endif
870 #ifndef SING
871 #define SING			_SING
872 #endif
873 
874     extern int matherr(struct exception *ep)
875     {
876 	const char *message;
877 	switch(ep->type)
878 	{
879 #ifdef DOMAIN
880 	    case DOMAIN:
881 		message = ERROR_dictionary(e_domain);
882 		break;
883 #endif
884 #ifdef OVERFLOW
885 	    case OVERFLOW:
886 		message = ERROR_dictionary(e_overflow);
887 		break;
888 #endif
889 #ifdef SING
890 	    case SING:
891 		message = ERROR_dictionary(e_singularity);
892 		break;
893 #endif
894 	    default:
895 		return(1);
896 	}
897 	level=0;
898 	errormsg(SH_DICT,ERROR_exit(1),message,ep->name);
899 	return(0);
900     }
901 
902 #undef	extern
903 
904 #endif /* _mem_name_exception */
905