1/*
2 * math.c - mathematical expression evaluation
3 *
4 * This file is part of zsh, the Z shell.
5 *
6 * Copyright (c) 1992-1997 Paul Falstad
7 * All rights reserved.
8 *
9 * Permission is hereby granted, without written agreement and without
10 * license or royalty fees, to use, copy, modify, and distribute this
11 * software and to distribute modified versions of this software for any
12 * purpose, provided that the above copyright notice and the following
13 * two paragraphs appear in all copies of this software.
14 *
15 * In no event shall Paul Falstad or the Zsh Development Group be liable
16 * to any party for direct, indirect, special, incidental, or consequential
17 * damages arising out of the use of this software and its documentation,
18 * even if Paul Falstad and the Zsh Development Group have been advised of
19 * the possibility of such damage.
20 *
21 * Paul Falstad and the Zsh Development Group specifically disclaim any
22 * warranties, including, but not limited to, the implied warranties of
23 * merchantability and fitness for a particular purpose.  The software
24 * provided hereunder is on an "as is" basis, and Paul Falstad and the
25 * Zsh Development Group have no obligation to provide maintenance,
26 * support, updates, enhancements, or modifications.
27 *
28 */
29
30struct mathvalue;
31
32#include "zsh.mdh"
33#include "math.pro"
34
35#include <math.h>
36
37/* nonzero means we are not evaluating, just parsing */
38
39/**/
40int noeval;
41
42/* integer zero */
43
44/**/
45mod_export mnumber zero_mnumber;
46
47/*
48 * The last value we computed:  note this isn't cleared
49 * until the next computation, unlike yyval.
50 * Everything else is saved and returned to allow recursive calls.
51 */
52/**/
53mnumber lastmathval;
54
55/* last input base we used */
56
57/**/
58int lastbase;
59
60static char *ptr;
61
62static mnumber yyval;
63static char *yylval;
64
65#define MAX_MLEVEL 256
66
67static int mlevel = 0;
68
69/* != 0 means recognize unary plus, minus, etc. */
70
71static int unary = 1;
72
73/* LR = left-to-right associativity *
74 * RL = right-to-left associativity *
75 * BOOL = short-circuiting boolean   */
76
77#define LR   0x0000
78#define RL   0x0001
79#define BOOL 0x0002
80
81#define MTYPE(x)  ((x) & 3)
82
83/*
84 * OP_A2    2 arguments
85 * OP_A2IR  2 arguments, return integer
86 * OP_A2IO  2 arguments, must be integer, return integer
87 * OP_E2    2 arguments with assignment
88 * OP_E2IO  2 arguments with assignment, must be integer, return integer
89 * OP_OP    None of the above, but occurs where we are expecting an operator
90 *          rather than an operand.
91 * OP_OPF   Followed by an operator, not an operand.
92 *
93 * OP_A2*, OP_E2*, OP_OP*:
94 *   Occur when we need an operator; the next object must be an operand,
95 *   unless OP_OPF is also supplied.
96 *
97 * Others:
98 *   Occur when we need an operand; the next object must also be an operand,
99 *   unless OP_OPF is also supplied.
100 */
101#define OP_A2   0x0004
102#define OP_A2IR 0x0008
103#define OP_A2IO 0x0010
104#define OP_E2   0x0020
105#define OP_E2IO 0x0040
106#define OP_OP   0x0080
107#define OP_OPF  0x0100
108
109#define M_INPAR 0
110#define M_OUTPAR 1
111#define NOT 2
112#define COMP 3
113#define POSTPLUS 4
114#define POSTMINUS 5
115#define UPLUS 6
116#define UMINUS 7
117#define AND 8
118#define XOR 9
119#define OR 10
120#define MUL 11
121#define DIV 12
122#define MOD 13
123#define PLUS 14
124#define MINUS 15
125#define SHLEFT 16
126#define SHRIGHT 17
127#define LES 18
128#define LEQ 19
129#define GRE 20
130#define GEQ 21
131#define DEQ 22
132#define NEQ 23
133#define DAND 24
134#define DOR 25
135#define DXOR 26
136#define QUEST 27
137#define COLON 28
138#define EQ 29
139#define PLUSEQ 30
140#define MINUSEQ 31
141#define MULEQ 32
142#define DIVEQ 33
143#define MODEQ 34
144#define ANDEQ 35
145#define XOREQ 36
146#define OREQ 37
147#define SHLEFTEQ 38
148#define SHRIGHTEQ 39
149#define DANDEQ 40
150#define DOREQ 41
151#define DXOREQ 42
152#define COMMA 43
153#define EOI 44
154#define PREPLUS 45
155#define PREMINUS 46
156#define NUM 47
157#define ID 48
158#define POWER 49
159#define CID 50
160#define POWEREQ 51
161#define FUNC 52
162#define TOKCOUNT 53
163
164/*
165 * Opeator recedences: in reverse order, i.e. lower number, high precedence.
166 * These are the C precedences.
167 *
168 * 0   Non-operators: NUM (numeric constant), ID (identifier),
169 *                    CID (identifier with '#'), FUNC (math function)
170 * 1   Opening parenthesis: M_INPAR '('  (for convenience, not an operator)
171 * 2   Unary operators: PREPLUS/POSTPLUS '++', PREMINUS/POSTMINUS '--',
172 *                      NOT '!', COMP '~', UPLUS '+', UMINUS '-'
173 * 3   POWER '**' (not in C but at high precedence in Perl)
174 * 4   MUL '*', DIV '/', MOD '%'
175 * 5   PLUS '+', MINUS '-'
176 * 6   SHLEFT '<<', SHRIGHT '>>'
177 * 7   GRE '>', 'GEQ' '>=', LES '<', LEQ '<='
178 * 8   DEQ '==', NEQ '!='
179 * 9   AND '&'
180 * 10  XOR '^'
181 * 11  OR  '|'
182 * 12  DAND '&&'
183 * 13  DXOR '^^' (not in C)
184 * 14  DOR '||'
185 * 15  QUEST '?'
186 * 16  COLON ':'
187 * 17  EQ '=', PLUSEQ '+=', MINUSEQ '-=', MULEQ '*=', DIVEQ '/=',
188 *     MODEQ '%=', ANDEQ '&=', XOREQ '^=', OREQ '|=',
189 *     SHFLEFTEQ '<<=', SHRIGHTEQ '>>=', DANDEQ '&&=', DOREQ '||=',
190 *     DXOREQ '^^='
191 * 18 COMMA ','
192 * 137 M_OUTPAR ')' (for convenience, not an operator)
193 * 200 EOI (end of input:  for convenience, not an operator)
194 */
195static int c_prec[TOKCOUNT] =
196{
197/*        M_INPAR   M_OUTPAR     NOT       COMP     POSTPLUS */
198/*  0 */     1,       137,        2,        2,         2,
199/*        POSTMINUS   UPLUS     UMINUS     AND        XOR    */
200/*  5 */     2,         2,        2,        9,        10,
201/*          OR         MUL       DIV       MOD       PLUS    */
202/* 10 */    11,         4,        4,        4,         5,
203/*         MINUS      SHLEFT   SHRIGHT     LES        LEQ    */
204/* 15 */     5,         6,        6,        7,         7,
205/*          GRE        GEQ       DEQ       NEQ       DAND    */
206/* 20 */     7,         7,        8,        8,        12,
207/*          DOR        DXOR     QUEST     COLON       EQ     */
208/* 25 */    14,        13,       15,       16,        17,
209/*         PLUSEQ    MINUSEQ    MULEQ     DIVEQ      MODEQ   */
210/* 30 */    17,        17,       17,       17,        17,
211/*         ANDEQ      XOREQ     OREQ    SHLEFTEQ   SHRIGHTEQ */
212/* 35 */    17,        17,       17,       17,        17,
213/*        DANDEQ      DOREQ    DXOREQ    COMMA       EOI     */
214/* 40 */    17,        17,       17,       18,       200,
215/*       PREPLUS    PREMINUS     NUM        ID       POWER   */
216/* 45 */     2,         2,        0,        0,         3,
217/*          CID      POWEREQ     FUNC  */
218/* 50 */     0,        17,        0
219};
220
221/*
222 * Opeator recedences: in reverse order, i.e. lower number, high precedence.
223 * These are the default zsh precedences.
224 *
225 * 0   Non-operators: NUM (numeric constant), ID (identifier),
226 *                    CID (identifier with '#'), FUNC (math function)
227 * 1   Opening parenthesis: M_INPAR '('  (for convenience, not an operator)
228 * 2   Unary operators: PREPLUS/POSTPLUS '++', PREMINUS/POSTMINUS '--',
229 *                      NOT '!', COMP '~', UPLUS '+', UMINUS '-'
230 * 3   SHLEFT '<<', SHRIGHT '>>'
231 * 4   AND '&'
232 * 5   XOR '^'
233 * 6   OR  '|'
234 * 7   POWER '**' (not in C but at high precedence in Perl)
235 * 8   MUL '*', DIV '/', MOD '%'
236 * 9   PLUS '+', MINUS '-'
237 * 10  GRE '>', 'GEQ' '>=', LES '<', LEQ '<='
238 * 11  DEQ '==', NEQ '!='
239 * 12  DAND '&&'
240 * 13  DOR '||', DXOR '^^' (not in C)
241 * 14  QUEST '?'
242 * 15  COLON ':'
243 * 16  EQ '=', PLUSEQ '+=', MINUSEQ '-=', MULEQ '*=', DIVEQ '/=',
244 *     MODEQ '%=', ANDEQ '&=', XOREQ '^=', OREQ '|=',
245 *     SHFLEFTEQ '<<=', SHRIGHTEQ '>>=', DANDEQ '&&=', DOREQ '||=',
246 *     DXOREQ '^^='
247 * 17 COMMA ','
248 * 137 M_OUTPAR ')' (for convenience, not an operator)
249 * 200 EOI (end of input:  for convenience, not an operator)
250 */
251static int z_prec[TOKCOUNT] =
252{
253/*        M_INPAR   M_OUTPAR     NOT       COMP     POSTPLUS */
254/*  0 */     1,       137,        2,        2,         2,
255/*        POSTMINUS   UPLUS     UMINUS     AND        XOR    */
256/*  5 */     2,         2,        2,        4,         5,
257/*          OR         MUL       DIV       MOD       PLUS    */
258/* 10 */     6,         8,        8,        8,         9,
259/*         MINUS      SHLEFT   SHRIGHT     LES        LEQ    */
260/* 15 */     9,         3,        3,       10,        10,
261/*          GRE        GEQ       DEQ       NEQ       DAND    */
262/* 20 */    10,        10,       11,       11,        12,
263/*          DOR        DXOR     QUEST     COLON       EQ     */
264/* 25 */    13,        13,       14,       15,        16,
265/*         PLUSEQ    MINUSEQ    MULEQ     DIVEQ      MODEQ   */
266/* 30 */    16,        16,       16,       16,        16,
267/*         ANDEQ      XOREQ     OREQ    SHLEFTEQ   SHRIGHTEQ */
268/* 35 */    16,        16,       16,       16,        16,
269/*        DANDEQ      DOREQ    DXOREQ    COMMA       EOI     */
270/* 40 */    16,        16,       16,       17,       200,
271/*       PREPLUS    PREMINUS     NUM        ID       POWER   */
272/* 45 */     2,         2,        0,        0,         7,
273/*          CID      POWEREQ     FUNC  */
274/* 50 */     0,        16,        0
275};
276
277/* Option-selectable preference table */
278static int *prec;
279
280/*
281 * Precedences for top and argument evaluation.  Careful:
282 * prec needs to be set before we use these.
283 */
284#define TOPPREC (prec[COMMA]+1)
285#define ARGPREC (prec[COMMA]-1)
286
287static int type[TOKCOUNT] =
288{
289/*  0 */  LR, LR|OP_OP|OP_OPF, RL, RL, RL|OP_OP|OP_OPF,
290/*  5 */  RL|OP_OP|OP_OPF, RL, RL, LR|OP_A2IO, LR|OP_A2IO,
291/* 10 */  LR|OP_A2IO, LR|OP_A2, LR|OP_A2, LR|OP_A2IO, LR|OP_A2,
292/* 15 */  LR|OP_A2, LR|OP_A2IO, LR|OP_A2IO, LR|OP_A2IR, LR|OP_A2IR,
293/* 20 */  LR|OP_A2IR, LR|OP_A2IR, LR|OP_A2IR, LR|OP_A2IR, BOOL|OP_A2IO,
294/* 25 */  BOOL|OP_A2IO, LR|OP_A2IO, RL|OP_OP, RL|OP_OP, RL|OP_E2,
295/* 30 */  RL|OP_E2, RL|OP_E2, RL|OP_E2, RL|OP_E2, RL|OP_E2IO,
296/* 35 */  RL|OP_E2IO, RL|OP_E2IO, RL|OP_E2IO, RL|OP_E2IO, RL|OP_E2IO,
297/* 40 */  BOOL|OP_E2IO, BOOL|OP_E2IO, RL|OP_A2IO, RL|OP_A2, RL|OP_OP,
298/* 45 */  RL, RL, LR|OP_OPF, LR|OP_OPF, RL|OP_A2,
299/* 50 */  LR|OP_OPF, RL|OP_E2, LR|OP_OPF
300};
301
302/* the value stack */
303
304#define STACKSZ 100
305static int mtok;			/* last token */
306static int sp = -1;			/* stack pointer */
307
308struct mathvalue {
309    /*
310     * If we need to get a variable, this is the string to be passed
311     * to the parameter code.  It may include a subscript.
312     */
313    char *lval;
314    /*
315     * If this is not zero, we've retrieved a variable and this
316     * stores a reference to it.
317     */
318    Value pval;
319    mnumber val;
320};
321
322static struct mathvalue *stack;
323
324enum prec_type {
325    /* Evaluating a top-level expression */
326    MPREC_TOP,
327    /* Evaluating a function argument */
328    MPREC_ARG
329};
330
331
332/*
333 * Get a number from a variable.
334 * Try to be clever about reusing subscripts by caching the Value structure.
335 */
336static mnumber
337getmathparam(struct mathvalue *mptr)
338{
339    if (!mptr->pval) {
340	char *s = mptr->lval;
341	mptr->pval = (Value)zhalloc(sizeof(struct value));
342	if (!getvalue(mptr->pval, &s, 1))
343	{
344	    mptr->pval = NULL;
345	    return zero_mnumber;
346	}
347    }
348    return getnumvalue(mptr->pval);
349}
350
351static mnumber
352mathevall(char *s, enum prec_type prec_tp, char **ep)
353{
354    int xlastbase, xnoeval, xunary, *xprec;
355    char *xptr;
356    mnumber xyyval;
357    char *xyylval;
358    int xsp;
359    struct mathvalue *xstack = 0, nstack[STACKSZ];
360    mnumber ret;
361
362    if (mlevel >= MAX_MLEVEL) {
363	xyyval.type = MN_INTEGER;
364	xyyval.u.l = 0;
365	*ep = s;
366
367	zerr("math recursion limit exceeded: %s", *ep);
368
369	return xyyval;
370    }
371    if (mlevel++) {
372	xlastbase = lastbase;
373	xnoeval = noeval;
374	xunary = unary;
375	xptr = ptr;
376	xyyval = yyval;
377	xyylval = yylval;
378
379	xsp = sp;
380	xstack = stack;
381	xprec = prec;
382    } else {
383	xlastbase = xnoeval = xunary = xsp = 0;
384	xyyval.type = MN_INTEGER;
385	xyyval.u.l = 0;
386	xyylval = NULL;
387	xptr = NULL;
388	xprec = NULL;
389    }
390    prec = isset(CPRECEDENCES) ? c_prec : z_prec;
391    stack = nstack;
392    lastbase = -1;
393    ptr = s;
394    sp = -1;
395    unary = 1;
396    stack[0].val.type = MN_INTEGER;
397    stack[0].val.u.l = 0;
398    mathparse(prec_tp == MPREC_TOP ? TOPPREC : ARGPREC);
399    *ep = ptr;
400    DPUTS(!errflag && sp > 0,
401	  "BUG: math: wallabies roaming too freely in outback");
402
403    if (errflag) {
404	/*
405	 * This used to set the return value to errflag.
406	 * I don't understand how that could be useful; the
407	 * caller doesn't know that's what's happened and
408	 * may not get a value at all.
409	 * Worse, we reset errflag in execarith() and setting
410	 * this explicitly non-zero means a (( ... )) returns
411	 * status 0 if there's an error.  That surely can't
412	 * be right.  execarith() now detects an error and returns
413	 * status 2.
414	 */
415	ret.type = MN_INTEGER;
416	ret.u.l = 0;
417    } else {
418	if (stack[0].val.type == MN_UNSET)
419	    ret = getmathparam(stack);
420	else
421	    ret = stack[0].val;
422    }
423
424    if (--mlevel) {
425	lastbase = xlastbase;
426	noeval = xnoeval;
427	unary = xunary;
428	ptr = xptr;
429	yyval = xyyval;
430	yylval = xyylval;
431
432	sp = xsp;
433	stack = xstack;
434	prec = xprec;
435    }
436    return lastmathval = ret;
437}
438
439static int
440lexconstant(void)
441{
442#ifdef USE_LOCALE
443    char *prev_locale;
444#endif
445    char *nptr;
446
447    nptr = ptr;
448    if (*nptr == '-')
449	nptr++;
450
451    if (*nptr == '0') {
452	nptr++;
453	if (*nptr == 'x' || *nptr == 'X') {
454	    /* Let zstrtol parse number with base */
455	    yyval.u.l = zstrtol_underscore(ptr, &ptr, 0, 1);
456	    /* Should we set lastbase here? */
457	    lastbase = 16;
458	    if (isset(FORCEFLOAT))
459	    {
460		yyval.type = MN_FLOAT;
461		yyval.u.d = (double)yyval.u.l;
462	    }
463	    return NUM;
464	}
465	else if (isset(OCTALZEROES))
466	{
467	    char *ptr2;
468
469	    /*
470	     * Make sure this is a real octal constant;
471	     * it can't be a base indication (always decimal)
472	     * or a floating point number.
473	     */
474	    for (ptr2 = nptr; idigit(*ptr2) || *ptr2 == '_'; ptr2++)
475		;
476
477	    if (ptr2 > nptr && *ptr2 != '.' && *ptr2 != 'e' &&
478		*ptr2 != 'E' && *ptr2 != '#')
479	    {
480		yyval.u.l = zstrtol_underscore(ptr, &ptr, 0, 1);
481		lastbase = 8;
482		if (isset(FORCEFLOAT))
483		{
484		    yyval.type = MN_FLOAT;
485		    yyval.u.d = (double)yyval.u.l;
486		}
487		return NUM;
488	    }
489	    nptr = ptr2;
490	}
491    }
492    while (idigit(*nptr) || *nptr == '_')
493	nptr++;
494
495    if (*nptr == '.' || *nptr == 'e' || *nptr == 'E') {
496	char *ptr2;
497	/* it's a float */
498	yyval.type = MN_FLOAT;
499#ifdef USE_LOCALE
500	prev_locale = dupstring(setlocale(LC_NUMERIC, NULL));
501	setlocale(LC_NUMERIC, "POSIX");
502#endif
503	if (*nptr == '.') {
504	    nptr++;
505	    while (idigit(*nptr) || *nptr == '_')
506		nptr++;
507	}
508	if (*nptr == 'e' || *nptr == 'E') {
509	    nptr++;
510	    if (*nptr == '+' || *nptr == '-')
511		nptr++;
512	    while (idigit(*nptr) || *nptr == '_')
513		nptr++;
514	}
515	for (ptr2 = ptr; ptr2 < nptr; ptr2++) {
516	    if (*ptr2 == '_') {
517		int len = nptr - ptr;
518		ptr = strdup(ptr);
519		for (ptr2 = ptr; len; len--) {
520		    if (*ptr2 == '_')
521			chuck(ptr2);
522		    else
523			ptr2++;
524		}
525		break;
526	    }
527	}
528	yyval.u.d = strtod(ptr, &nptr);
529#ifdef USE_LOCALE
530	if (prev_locale) setlocale(LC_NUMERIC, prev_locale);
531#endif
532	if (ptr == nptr || *nptr == '.') {
533	    zerr("bad floating point constant");
534	    return EOI;
535	}
536	ptr = nptr;
537    } else {
538	/* it's an integer */
539	yyval.u.l = zstrtol_underscore(ptr, &ptr, 10, 1);
540
541	if (*ptr == '#') {
542	    ptr++;
543	    lastbase = yyval.u.l;
544	    yyval.u.l = zstrtol_underscore(ptr, &ptr, lastbase, 1);
545	}
546	if (isset(FORCEFLOAT))
547	{
548	    yyval.type = MN_FLOAT;
549	    yyval.u.d = (double)yyval.u.l;
550	}
551    }
552    return NUM;
553}
554
555/**/
556int outputradix;
557
558/**/
559static int
560zzlex(void)
561{
562    int cct = 0;
563    char *ie;
564    yyval.type = MN_INTEGER;
565
566    for (;; cct = 0)
567	switch (*ptr++) {
568	case '+':
569	    if (*ptr == '+') {
570		ptr++;
571		return (unary) ? PREPLUS : POSTPLUS;
572	    }
573	    if (*ptr == '=') {
574		ptr++;
575		return PLUSEQ;
576	    }
577	    return (unary) ? UPLUS : PLUS;
578	case '-':
579	    if (*ptr == '-') {
580		ptr++;
581		return (unary) ? PREMINUS : POSTMINUS;
582	    }
583	    if (*ptr == '=') {
584		ptr++;
585		return MINUSEQ;
586	    }
587	    if (unary) {
588		if (idigit(*ptr) || *ptr == '.') {
589		    ptr--;
590		    return lexconstant();
591		} else
592		    return UMINUS;
593	    } else
594		return MINUS;
595	case '(':
596	    return M_INPAR;
597	case ')':
598	    return M_OUTPAR;
599	case '!':
600	    if (*ptr == '=') {
601		ptr++;
602		return NEQ;
603	    }
604	    return NOT;
605	case '~':
606	    return COMP;
607	case '&':
608	    if (*ptr == '&') {
609		if (*++ptr == '=') {
610		    ptr++;
611		    return DANDEQ;
612		}
613		return DAND;
614	    } else if (*ptr == '=') {
615		ptr++;
616		return ANDEQ;
617	    }
618	    return AND;
619	case '|':
620	    if (*ptr == '|') {
621		if (*++ptr == '=') {
622		    ptr++;
623		    return DOREQ;
624		}
625		return DOR;
626	    } else if (*ptr == '=') {
627		ptr++;
628		return OREQ;
629	    }
630	    return OR;
631	case '^':
632	    if (*ptr == '^') {
633		if (*++ptr == '=') {
634		    ptr++;
635		    return DXOREQ;
636		}
637		return DXOR;
638	    } else if (*ptr == '=') {
639		ptr++;
640		return XOREQ;
641	    }
642	    return XOR;
643	case '*':
644	    if (*ptr == '*') {
645		if (*++ptr == '=') {
646		    ptr++;
647		    return POWEREQ;
648		}
649		return POWER;
650	    }
651	    if (*ptr == '=') {
652		ptr++;
653		return MULEQ;
654	    }
655	    return MUL;
656	case '/':
657	    if (*ptr == '=') {
658		ptr++;
659		return DIVEQ;
660	    }
661	    return DIV;
662	case '%':
663	    if (*ptr == '=') {
664		ptr++;
665		return MODEQ;
666	    }
667	    return MOD;
668	case '<':
669	    if (*ptr == '<') {
670		if (*++ptr == '=') {
671		    ptr++;
672		    return SHLEFTEQ;
673		}
674		return SHLEFT;
675	    } else if (*ptr == '=') {
676		ptr++;
677		return LEQ;
678	    }
679	    return LES;
680	case '>':
681	    if (*ptr == '>') {
682		if (*++ptr == '=') {
683		    ptr++;
684		    return SHRIGHTEQ;
685		}
686		return SHRIGHT;
687	    } else if (*ptr == '=') {
688		ptr++;
689		return GEQ;
690	    }
691	    return GRE;
692	case '=':
693	    if (*ptr == '=') {
694		ptr++;
695		return DEQ;
696	    }
697	    return EQ;
698	case '$':
699	    yyval.u.l = mypid;
700	    return NUM;
701	case '?':
702	    if (unary) {
703		yyval.u.l = lastval;
704		return NUM;
705	    }
706	    return QUEST;
707	case ':':
708	    return COLON;
709	case ',':
710	    return COMMA;
711	case '\0':
712	    ptr--;
713	    return EOI;
714	case '[':
715	    {
716		int n;
717
718		if (idigit(*ptr)) {
719		    n = zstrtol(ptr, &ptr, 10);
720		    if (*ptr != ']' || !idigit(*++ptr)) {
721			zerr("bad base syntax");
722			return EOI;
723		    }
724		    yyval.u.l = zstrtol(ptr, &ptr, lastbase = n);
725		    return NUM;
726		}
727		if (*ptr == '#') {
728		    n = 1;
729		    if (*++ptr == '#') {
730			n = -1;
731			ptr++;
732		    }
733		    if (!idigit(*ptr))
734			goto bofs;
735		    outputradix = n * zstrtol(ptr, &ptr, 10);
736		} else {
737		    bofs:
738		    zerr("bad output format specification");
739		    return EOI;
740		}
741		if(*ptr != ']')
742			goto bofs;
743		n = (outputradix < 0) ? -outputradix : outputradix;
744		if (n < 2 || n > 36) {
745		    zerr("invalid base (must be 2 to 36 inclusive): %d",
746			 outputradix);
747		    return EOI;
748		}
749		ptr++;
750		break;
751	    }
752	case ' ':
753	case '\t':
754	case '\n':
755	    break;
756	/* Fall through! */
757	default:
758	    if (idigit(*--ptr) || *ptr == '.')
759		return lexconstant();
760	    if (*ptr == '#') {
761		if (*++ptr == '\\' || *ptr == '#') {
762		    int v;
763
764		    ptr++;
765		    if (!*ptr) {
766			zerr("character missing after ##");
767			return EOI;
768		    }
769		    ptr = getkeystring(ptr, NULL, GETKEYS_MATH, &v);
770		    yyval.u.l = v;
771		    return NUM;
772		}
773		cct = 1;
774	    }
775	    if ((ie = itype_end(ptr, IIDENT, 0)) != ptr) {
776		int func = 0;
777		char *p;
778
779		p = ptr;
780		ptr = ie;
781		if (*ptr == '[' || (!cct && *ptr == '(')) {
782		    char op = *ptr, cp = ((*ptr == '[') ? ']' : ')');
783		    int l;
784		    func = (op == '(');
785		    for (ptr++, l = 1; *ptr && l; ptr++) {
786			if (*ptr == op)
787			    l++;
788			if (*ptr == cp)
789			    l--;
790			if (*ptr == '\\' && ptr[1])
791			    ptr++;
792		    }
793		}
794		yylval = dupstrpfx(p, ptr - p);
795		return (func ? FUNC : (cct ? CID : ID));
796	    }
797	    else if (cct) {
798		yyval.u.l = poundgetfn(NULL);
799		return NUM;
800	    }
801	    return EOI;
802	}
803}
804
805/**/
806static void
807push(mnumber val, char *lval, int getme)
808{
809    if (sp == STACKSZ - 1)
810	zerr("stack overflow");
811    else
812	sp++;
813    stack[sp].val = val;
814    stack[sp].lval = lval;
815    stack[sp].pval = NULL;
816    if (getme)
817	stack[sp].val.type = MN_UNSET;
818}
819
820/**/
821static mnumber
822pop(int noget)
823{
824    struct mathvalue *mv = stack+sp;
825
826    if (mv->val.type == MN_UNSET && !noget)
827	mv->val = getmathparam(mv);
828    sp--;
829    return errflag ? zero_mnumber : mv->val;
830}
831
832/**/
833static mnumber
834getcvar(char *s)
835{
836    char *t;
837    mnumber mn;
838    mn.type = MN_INTEGER;
839
840    queue_signals();
841    if (!(t = getsparam(s)))
842	mn.u.l = 0;
843    else {
844#ifdef MULTIBYTE_SUPPORT
845	if (isset(MULTIBYTE)) {
846	    wint_t wc;
847	    (void)mb_metacharlenconv(t, &wc);
848	    if (wc != WEOF) {
849		mn.u.l = (zlong)wc;
850		unqueue_signals();
851		return mn;
852	    }
853	}
854#endif
855	mn.u.l = STOUC(*t == Meta ? t[1] ^ 32 : *t);
856    }
857    unqueue_signals();
858    return mn;
859}
860
861
862/**/
863static mnumber
864setmathvar(struct mathvalue *mvp, mnumber v)
865{
866    if (mvp->pval) {
867	/*
868	 * This value may have been hanging around for a while.
869	 * Be ultra-paranoid in checking the variable is still valid.
870	 */
871	char *s = mvp->lval, *ptr;
872	Param pm;
873	DPUTS(!mvp->lval, "no variable name but variable value in math");
874	if ((ptr = strchr(s, '[')))
875	    s = dupstrpfx(s, ptr - s);
876	pm = (Param) paramtab->getnode(paramtab, s);
877	if (pm == mvp->pval->pm) {
878	    if (noeval)
879		return v;
880	    setnumvalue(mvp->pval, v);
881	    return v;
882	}
883	/* Different parameter, start again from scratch */
884	mvp->pval = NULL;
885    }
886    if (!mvp->lval) {
887	zerr("lvalue required");
888	v.type = MN_INTEGER;
889	v.u.l = 0;
890	return v;
891    }
892    if (noeval)
893	return v;
894    untokenize(mvp->lval);
895    setnparam(mvp->lval, v);
896    return v;
897}
898
899
900/**/
901static mnumber
902callmathfunc(char *o)
903{
904    MathFunc f;
905    char *a, *n;
906    static mnumber dummy;
907
908    n = a = dupstring(o);
909
910    while (*a != '(')
911	a++;
912    *a++ = '\0';
913    a[strlen(a) - 1] = '\0';
914
915    if ((f = getmathfunc(n, 1))) {
916	if (f->flags & MFF_STR) {
917	    return f->sfunc(n, a, f->funcid);
918	} else {
919	    int argc = 0;
920	    mnumber *argv = NULL, *q, marg;
921	    LinkList l = newlinklist();
922	    LinkNode node;
923
924	    if (f->flags & MFF_USERFUNC) {
925		/* first argument is function name: always use mathfunc */
926		addlinknode(l, n);
927	    }
928
929	    while (iblank(*a))
930		a++;
931	    while (*a) {
932		if (*a) {
933		    argc++;
934		    if (f->flags & MFF_USERFUNC) {
935			/* need to pass strings */
936			char *str;
937			marg = mathevall(a, MPREC_ARG, &a);
938			if (marg.type & MN_FLOAT) {
939			    /* convfloat is off the heap */
940			    str = convfloat(marg.u.d, 0, 0, NULL);
941			} else {
942			    char buf[BDIGBUFSIZE];
943			    convbase(buf, marg.u.l, 10);
944			    str = dupstring(buf);
945			}
946			addlinknode(l, str);
947		    } else {
948			q = (mnumber *) zhalloc(sizeof(mnumber));
949			*q = mathevall(a, MPREC_ARG, &a);
950			addlinknode(l, q);
951		    }
952		    if (errflag || mtok != COMMA)
953			break;
954		}
955	    }
956	    if (*a && !errflag)
957		zerr("bad math expression: illegal character: %c", *a);
958	    if (!errflag) {
959		if (argc >= f->minargs && (f->maxargs < 0 ||
960					   argc <= f->maxargs)) {
961		    if (f->flags & MFF_USERFUNC) {
962			char *shfnam = f->module ? f->module : n;
963			Shfunc shfunc = getshfunc(shfnam);
964			if (!shfunc)
965			    zerr("no such function: %s", shfnam);
966			else {
967			    doshfunc(shfunc, l, 1);
968			    return lastmathval;
969			}
970		    } else {
971			if (argc) {
972			    q = argv =
973				(mnumber *)zhalloc(argc * sizeof(mnumber));
974			    for (node = firstnode(l); node; incnode(node))
975				*q++ = *(mnumber *)getdata(node);
976			}
977			return f->nfunc(n, argc, argv, f->funcid);
978		    }
979		} else
980		    zerr("wrong number of arguments: %s", o);
981	    }
982	}
983    } else {
984	zerr("unknown function: %s", n);
985    }
986
987    dummy.type = MN_INTEGER;
988    dummy.u.l = 0;
989
990    return dummy;
991}
992
993/**/
994static int
995notzero(mnumber a)
996{
997    if ((a.type & MN_INTEGER) ? a.u.l == 0 : a.u.d == 0.0) {
998	zerr("division by zero");
999	return 0;
1000    }
1001    return 1;
1002}
1003
1004/* macro to pop three values off the value stack */
1005
1006/**/
1007void
1008op(int what)
1009{
1010    mnumber a, b, c, *spval;
1011    int tp = type[what];
1012
1013    if (errflag)
1014	return;
1015    if (sp < 0) {
1016	zerr("bad math expression: stack empty");
1017	return;
1018    }
1019
1020    if (tp & (OP_A2|OP_A2IR|OP_A2IO|OP_E2|OP_E2IO)) {
1021	/* Make sure anyone seeing this message reports it. */
1022	DPUTS(sp < 1, "BUG: math: not enough wallabies in outback.");
1023	b = pop(0);
1024	a = pop(what == EQ);
1025	if (errflag)
1026	    return;
1027
1028	if (tp & (OP_A2IO|OP_E2IO)) {
1029	    /* coerce to integers */
1030	    if (a.type & MN_FLOAT) {
1031		a.type = MN_INTEGER;
1032		a.u.l = (zlong)a.u.d;
1033	    }
1034	    if (b.type & MN_FLOAT) {
1035		b.type = MN_INTEGER;
1036		b.u.l = (zlong)b.u.d;
1037	    }
1038	} else if (a.type != b.type && what != COMMA &&
1039		   (a.type != MN_UNSET || what != EQ)) {
1040	    /*
1041	     * Different types, so coerce to float.
1042	     * It may happen during an assignment that the LHS
1043	     * variable is actually an integer, but there's still
1044	     * no harm in doing the arithmetic in floating point;
1045	     * the assignment will do the correct conversion.
1046	     * This way, if the parameter is actually a scalar, but
1047	     * used to contain an integer, we can write a float into it.
1048	     */
1049	    if (a.type & MN_INTEGER) {
1050		a.type = MN_FLOAT;
1051		a.u.d = (double)a.u.l;
1052	    }
1053	    if (b.type & MN_INTEGER) {
1054		b.type = MN_FLOAT;
1055		b.u.d = (double)b.u.l;
1056	    }
1057	}
1058
1059	if (noeval) {
1060	    c.type = MN_INTEGER;
1061	    c.u.l = 0;
1062	} else {
1063	    /*
1064	     * type for operation: usually same as operands, but e.g.
1065	     * (a == b) returns int.
1066	     */
1067	    c.type = (tp & OP_A2IR) ? MN_INTEGER : a.type;
1068
1069	    switch(what) {
1070	    case AND:
1071	    case ANDEQ:
1072		c.u.l = a.u.l & b.u.l;
1073		break;
1074	    case XOR:
1075	    case XOREQ:
1076		c.u.l = a.u.l ^ b.u.l;
1077		break;
1078	    case OR:
1079	    case OREQ:
1080		c.u.l = a.u.l | b.u.l;
1081		break;
1082	    case MUL:
1083	    case MULEQ:
1084		if (c.type == MN_FLOAT)
1085		    c.u.d = a.u.d * b.u.d;
1086		else
1087		    c.u.l = a.u.l * b.u.l;
1088		break;
1089	    case DIV:
1090	    case DIVEQ:
1091		if (!notzero(b))
1092		    return;
1093		if (c.type == MN_FLOAT)
1094		    c.u.d = a.u.d / b.u.d;
1095		else {
1096		    /*
1097		     * Avoid exception when dividing the smallest
1098		     * negative integer by -1.  Always treat it the
1099		     * same as multiplication.  This still doesn't give
1100		     * numerically the right answer in two's complement,
1101		     * but treating both these in the same way seems
1102		     * reasonable.
1103		     */
1104		    if (b.u.l == -1)
1105			c.u.l = - a.u.l;
1106		    else
1107			c.u.l = a.u.l / b.u.l;
1108		}
1109		break;
1110	    case MOD:
1111	    case MODEQ:
1112		if (!notzero(b))
1113		    return;
1114		/*
1115		 * Avoid exception as above.
1116		 * Any integer mod -1 is the same as any integer mod 1
1117		 * i.e. zero.
1118		 */
1119		if (b.u.l == -1)
1120		    c.u.l = 0;
1121		else
1122		    c.u.l = a.u.l % b.u.l;
1123		break;
1124	    case PLUS:
1125	    case PLUSEQ:
1126		if (c.type == MN_FLOAT)
1127		    c.u.d = a.u.d + b.u.d;
1128		else
1129		    c.u.l = a.u.l + b.u.l;
1130		break;
1131	    case MINUS:
1132	    case MINUSEQ:
1133		if (c.type == MN_FLOAT)
1134		    c.u.d = a.u.d - b.u.d;
1135		else
1136		    c.u.l = a.u.l - b.u.l;
1137		break;
1138	    case SHLEFT:
1139	    case SHLEFTEQ:
1140		c.u.l = a.u.l << b.u.l;
1141		break;
1142	    case SHRIGHT:
1143	    case SHRIGHTEQ:
1144		c.u.l = a.u.l >> b.u.l;
1145		break;
1146	    case LES:
1147		c.u.l = (zlong)
1148		    (a.type == MN_FLOAT ? (a.u.d < b.u.d) : (a.u.l < b.u.l));
1149		break;
1150	    case LEQ:
1151		c.u.l = (zlong)
1152		    (a.type == MN_FLOAT ? (a.u.d <= b.u.d) : (a.u.l <= b.u.l));
1153		break;
1154	    case GRE:
1155		c.u.l = (zlong)
1156		    (a.type == MN_FLOAT ? (a.u.d > b.u.d) : (a.u.l > b.u.l));
1157		break;
1158	    case GEQ:
1159		c.u.l = (zlong)
1160		    (a.type == MN_FLOAT ? (a.u.d >= b.u.d) : (a.u.l >= b.u.l));
1161		break;
1162	    case DEQ:
1163		c.u.l = (zlong)
1164		    (a.type == MN_FLOAT ? (a.u.d == b.u.d) : (a.u.l == b.u.l));
1165		break;
1166	    case NEQ:
1167		c.u.l = (zlong)
1168		    (a.type == MN_FLOAT ? (a.u.d != b.u.d) : (a.u.l != b.u.l));
1169		break;
1170	    case DAND:
1171	    case DANDEQ:
1172		c.u.l = (zlong)(a.u.l && b.u.l);
1173		break;
1174	    case DOR:
1175	    case DOREQ:
1176		c.u.l = (zlong)(a.u.l || b.u.l);
1177		break;
1178	    case DXOR:
1179	    case DXOREQ:
1180		c.u.l = (zlong)((a.u.l && !b.u.l) || (!a.u.l && b.u.l));
1181		break;
1182	    case COMMA:
1183		c = b;
1184		break;
1185	    case POWER:
1186	    case POWEREQ:
1187		if (c.type == MN_INTEGER && b.u.l < 0) {
1188		    /* produces a real result, so cast to real. */
1189		    a.type = b.type = c.type = MN_FLOAT;
1190		    a.u.d = (double) a.u.l;
1191		    b.u.d = (double) b.u.l;
1192		}
1193		if (c.type == MN_INTEGER) {
1194		    for (c.u.l = 1; b.u.l--; c.u.l *= a.u.l);
1195		} else {
1196		    if (b.u.d <= 0 && !notzero(a))
1197			return;
1198		    if (a.u.d < 0) {
1199			/* Error if (-num ** b) and b is not an integer */
1200			double tst = (double)(zlong)b.u.d;
1201			if (tst != b.u.d) {
1202			    zerr("imaginary power");
1203			    return;
1204			}
1205		    }
1206		    c.u.d = pow(a.u.d, b.u.d);
1207		}
1208		break;
1209	    case EQ:
1210		c = b;
1211		break;
1212	    }
1213	}
1214	if (tp & (OP_E2|OP_E2IO)) {
1215	    struct mathvalue *mvp = stack + sp + 1;
1216	    c = setmathvar(mvp, c);
1217	    push(c, mvp->lval, 0);
1218	} else
1219	    push(c,NULL, 0);
1220	return;
1221    }
1222
1223    spval = &stack[sp].val;
1224    if (stack[sp].val.type == MN_UNSET)
1225	*spval = getmathparam(stack + sp);
1226    switch (what) {
1227    case NOT:
1228	if (spval->type & MN_FLOAT) {
1229	    spval->u.l = !spval->u.d;
1230	    spval->type = MN_INTEGER;
1231	} else
1232	    spval->u.l = !spval->u.l;
1233	stack[sp].lval = NULL;
1234	stack[sp].pval = NULL;
1235	break;
1236    case COMP:
1237	if (spval->type & MN_FLOAT) {
1238	    spval->u.l = ~((zlong)spval->u.d);
1239	    spval->type = MN_INTEGER;
1240	} else
1241	    spval->u.l = ~spval->u.l;
1242	stack[sp].lval = NULL;
1243	stack[sp].pval = NULL;
1244	break;
1245    case POSTPLUS:
1246	a = *spval;
1247	if (spval->type & MN_FLOAT)
1248	    a.u.d++;
1249	else
1250	    a.u.l++;
1251	(void)setmathvar(stack + sp, a);
1252	break;
1253    case POSTMINUS:
1254	a = *spval;
1255	if (spval->type & MN_FLOAT)
1256	    a.u.d--;
1257	else
1258	    a.u.l--;
1259	(void)setmathvar(stack + sp, a);
1260	break;
1261    case UPLUS:
1262	stack[sp].lval = NULL;
1263	stack[sp].pval = NULL;
1264	break;
1265    case UMINUS:
1266	if (spval->type & MN_FLOAT)
1267	    spval->u.d = -spval->u.d;
1268	else
1269	    spval->u.l = -spval->u.l;
1270	stack[sp].lval = NULL;
1271	stack[sp].pval = NULL;
1272	break;
1273    case QUEST:
1274	DPUTS(sp < 2, "BUG: math: three shall be the number of the counting.");
1275	c = pop(0);
1276	b = pop(0);
1277	a = pop(0);
1278	if (errflag)
1279	    return;
1280	/* b and c can stay different types in this case. */
1281	push(((a.type & MN_FLOAT) ? a.u.d : a.u.l) ? b : c, NULL, 0);
1282	break;
1283    case COLON:
1284	zerr("':' without '?'");
1285	break;
1286    case PREPLUS:
1287	if (spval->type & MN_FLOAT)
1288	    spval->u.d++;
1289	else
1290	    spval->u.l++;
1291	setmathvar(stack + sp, *spval);
1292	break;
1293    case PREMINUS:
1294	if (spval->type & MN_FLOAT)
1295	    spval->u.d--;
1296	else
1297	    spval->u.l--;
1298	setmathvar(stack + sp, *spval);
1299	break;
1300    default:
1301	zerr("out of integers");
1302	return;
1303    }
1304}
1305
1306
1307/**/
1308static void
1309bop(int tk)
1310{
1311    mnumber *spval = &stack[sp].val;
1312    int tst;
1313
1314    if (stack[sp].val.type == MN_UNSET)
1315	*spval = getmathparam(stack + sp);
1316    tst = (spval->type & MN_FLOAT) ? (zlong)spval->u.d : spval->u.l;
1317
1318    switch (tk) {
1319    case DAND:
1320    case DANDEQ:
1321	if (!tst)
1322	    noeval++;
1323	break;
1324    case DOR:
1325    case DOREQ:
1326	if (tst)
1327	    noeval++;
1328	break;
1329    };
1330}
1331
1332
1333/**/
1334mod_export mnumber
1335matheval(char *s)
1336{
1337    char *junk;
1338    mnumber x;
1339    int xmtok = mtok;
1340    /* maintain outputradix across levels of evaluation */
1341    if (!mlevel)
1342	outputradix = 0;
1343
1344    if (!*s) {
1345	x.type = MN_INTEGER;
1346	x.u.l = 0;
1347	return x;
1348    }
1349    x = mathevall(s, MPREC_TOP, &junk);
1350    mtok = xmtok;
1351    if (*junk)
1352	zerr("bad math expression: illegal character: %c", *junk);
1353    return x;
1354}
1355
1356/**/
1357mod_export zlong
1358mathevali(char *s)
1359{
1360    mnumber x = matheval(s);
1361    return (x.type & MN_FLOAT) ? (zlong)x.u.d : x.u.l;
1362}
1363
1364
1365/**/
1366zlong
1367mathevalarg(char *s, char **ss)
1368{
1369    mnumber x;
1370    int xmtok = mtok;
1371
1372    /*
1373     * At this entry point we don't allow an empty expression,
1374     * whereas we do with matheval().  I'm not sure if this
1375     * difference is deliberate, but it does mean that e.g.
1376     * $array[$ind] where ind hasn't been set produces an error,
1377     * which is probably safe.
1378     *
1379     * To avoid a more opaque error further in, bail out here.
1380     */
1381    if (!*s) {
1382	zerr("bad math expression: empty string");
1383	return (zlong)0;
1384    }
1385    x = mathevall(s, MPREC_ARG, ss);
1386    if (mtok == COMMA)
1387	(*ss)--;
1388    mtok = xmtok;
1389    return (x.type & MN_FLOAT) ? (zlong)x.u.d : x.u.l;
1390}
1391
1392/*
1393 * Make sure we have an operator or an operand, whatever is expected.
1394 * For this purpose, unary operators constitute part of an operand.
1395 */
1396
1397/**/
1398static void
1399checkunary(int mtokc, char *mptr)
1400{
1401    int errmsg = 0;
1402    int tp = type[mtokc];
1403    if (tp & (OP_A2|OP_A2IR|OP_A2IO|OP_E2|OP_E2IO|OP_OP)) {
1404	if (unary)
1405	    errmsg = 1;
1406    } else {
1407	if (!unary)
1408	    errmsg = 2;
1409    }
1410    if (errmsg) {
1411	int len, over = 0;
1412	char *errtype = errmsg == 2 ? "operator" : "operand";
1413	while (inblank(*mptr))
1414	    mptr++;
1415	len = ztrlen(mptr);
1416	if (len > 10) {
1417	    len = 10;
1418	    over = 1;
1419	}
1420	if (!*mptr)
1421	    zerr("bad math expression: %s expected at end of string",
1422		errtype);
1423	else
1424	    zerr("bad math expression: %s expected at `%l%s'",
1425		 errtype, mptr, len, over ? "..." : "");
1426    }
1427    unary = !(tp & OP_OPF);
1428}
1429
1430/* operator-precedence parse the string and execute */
1431
1432/**/
1433static void
1434mathparse(int pc)
1435{
1436    zlong q;
1437    int otok, onoeval;
1438    char *optr = ptr;
1439
1440    if (errflag)
1441	return;
1442    mtok = zzlex();
1443    /* Handle empty input */
1444    if (pc == TOPPREC && mtok == EOI)
1445	return;
1446    checkunary(mtok, optr);
1447    while (prec[mtok] <= pc) {
1448	if (errflag)
1449	    return;
1450	switch (mtok) {
1451	case NUM:
1452	    push(yyval, NULL, 0);
1453	    break;
1454	case ID:
1455	    push(zero_mnumber, yylval, !noeval);
1456	    break;
1457	case CID:
1458	    push((noeval ? zero_mnumber : getcvar(yylval)), yylval, 0);
1459	    break;
1460	case FUNC:
1461	    push((noeval ? zero_mnumber : callmathfunc(yylval)), yylval, 0);
1462	    break;
1463	case M_INPAR:
1464	    mathparse(TOPPREC);
1465	    if (mtok != M_OUTPAR) {
1466		if (!errflag)
1467		    zerr("')' expected");
1468		return;
1469	    }
1470	    break;
1471	case QUEST:
1472	    if (stack[sp].val.type == MN_UNSET)
1473		stack[sp].val = getmathparam(stack + sp);
1474	    q = (stack[sp].val.type == MN_FLOAT) ?
1475		(stack[sp].val.u.d == 0 ? 0 : 1) :
1476		stack[sp].val.u.l;
1477
1478	    if (!q)
1479		noeval++;
1480	    mathparse(prec[COLON] - 1);
1481	    if (!q)
1482		noeval--;
1483	    if (mtok != COLON) {
1484		if (!errflag)
1485		    zerr("':' expected");
1486		return;
1487	    }
1488	    if (q)
1489		noeval++;
1490	    mathparse(prec[QUEST]);
1491	    if (q)
1492		noeval--;
1493	    op(QUEST);
1494	    continue;
1495	default:
1496	    otok = mtok;
1497	    onoeval = noeval;
1498	    if (MTYPE(type[otok]) == BOOL)
1499		bop(otok);
1500	    mathparse(prec[otok] - (MTYPE(type[otok]) != RL));
1501	    noeval = onoeval;
1502	    op(otok);
1503	    continue;
1504	}
1505	optr = ptr;
1506	mtok = zzlex();
1507	checkunary(mtok, optr);
1508    }
1509}
1510