Authors: Mike Lutz & Bob Harper
Editors: Ozan Yigit & Richard A. O'Keefe
Purpose: arithmetic expression evaluator.
expr() performs a standard recursive descent parse to evaluate any
expression permitted byf the following grammar:
| lor "?" query ":" query
lor : land { "||" land } or OR, for Pascal
land : bor { "&&" bor } or AND, for Pascal
eql : relat { eqrel relat }
relat : shift { rel shift }
shift : primary { shop primary }
primary : term { addop term }
term : unary { mulop unary }
| "'" CHAR "'" or '"' CHAR '"'
num : DIGIT full ANSI C syntax
rel : "<" or <>, Pascal not-equal
| "<=" or =<, for Prolog users.
This expression evaluator was lifted from a public-domain
C Pre-Processor included with the DECUS C Compiler distribution.
It has been hacked somewhat to be suitable for m4.
26-Mar-1993 Changed to work in any of EBCDIC, ASCII, DEC MNCS,
26-Mar-1993 Changed to use "long int" rather than int, so that
we get the same 32-bit arithmetic on a PC as on a Sun.
It isn't fully portable, of course, but then on a 64-
bit machine we _want_ 64-bit arithmetic...
Shifting rewritten (using LONG_BIT) to give signed
shifts even when (long) >> (long) is unsigned.
26-Mar-1993 I finally got sick of the fact that &&, ||, and ?:
don't do conditional evaluation. What is the good
of having eval(0&&(1/0)) crash and dump core? Now
every function has a doit? argument.
26-Mar-1993 charcon() didn't actually accept 'abcd', which it
20-Apr-1993 eval(1/0) and eval(1%0) dumped core and crashed.
This is also true of the System V r 3.2 m4, but
it isn't good enough for ours! Changed it so that
x % 0 => x as per Concrete Mathematics
x / 0 => error and return 0 from expr().
static jmp_buf expjump
; /* Error exit point for expr() */
static unsigned char *nxtchr
; /* Parser scan pointer */
#define deblank0 while ((unsigned)(*nxtchr-1) < ' ') nxtchr++
#define deblank1 while ((unsigned)(*++nxtchr - 1) < ' ')
#define deblank2 nxtchr++; deblank1
static char digval
[1+UCHAR_MAX
];
/* This file should work in any C implementation that doesn't have too
many characters to fit in one table. We use a table to convert
(unsigned) characters to numeric codes:
Instead of asking whether tolower(c) == 'a' we ask whether
digval[c] == DIGIT_A, and so on. This essentially duplicates the
chtype[] table in main.c; we should use just one table.
static long int query(int);
prints an error message, resets environment to expr(), and
forces expr() to return FALSE.
(void) fprintf(stderr
, "m4: %s\n", msg
);
longjmp(expjump
, -1); /* Force expr() to return FALSE */
/* <numcon> ::= '0x' <hex> | '0X' <hex> | '0' <oct> | <dec>
For ANSI C, an integer may be followed by u, l, ul, or lu,
in any mix of cases. We accept and ignore those letters;
all the numbers are treated as long.
static long int numcon(doit
)
register long int v
; /* current value */
register int b
; /* base (radix) */
register int c
; /* character or digit value */
do nxtchr
++; while (digval
[*nxtchr
] <= 36);
v
= digval
[*nxtchr
++]; /* We already know it's a digit */
b
= 10; /* decimal number */
if (digval
[*nxtchr
] == DIGIT_X
) {
b
= 16; /* hexadecimal number */
b
= 8; /* octal number */
while (digval
[c
= *nxtchr
++] < b
) v
= v
*b
+ digval
[c
];
while (digval
[c
] == DIGIT_L
|| digval
[c
] == DIGIT_U
) c
= *nxtchr
++;
if ((unsigned)(c
-1) < ' ') { deblank1
; }
/* <charcon> ::= <qt> { <char> } <qt>
Note: multibyte constants are accepted.
Note: BEL (\a) and ESC (\e) have the same values in EBCDIC and ASCII.
static long int charcon(doit
)
q
= *nxtchr
++; /* the quote character */
if (c
== q
) { /* end of literal, or doubled quote */
nxtchr
++; /* doubled quote stands for one quote */
if (i
== sizeof value
) experr("Unterminated character constant");
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
if ((unsigned)(*nxtchr
- '0') < 8)
c
= (c
<< 3) | (*nxtchr
++ - '0');
if ((unsigned)(*nxtchr
- '0') < 8)
c
= (c
<< 3) | (*nxtchr
++ - '0');
case 'n': case 'N': c
= '\n'; break;
case 'r': case 'R': c
= '\r'; break;
case 't': case 'T': c
= '\t'; break;
case 'b': case 'B': c
= '\b'; break;
case 'f': case 'F': c
= '\f'; break;
case 'a': case 'A': c
= 007; break;
case 'e': case 'E': c
= 033; break;
case 'd': case 'D': c
= 045; break; /*EBCDIC DEL */
case 'd': case 'D': c
= 127; break; /* ASCII DEL */
for (value
= 0; --i
>= 0; ) value
= (value
<< CHAR_BIT
) | v
[i
];
/* <unary> ::= <unop> <unary> | <factor>
<unop> ::= '!' || '~' | '-'
<factor> ::= '(' <query> ')' | <'> <char> <'> | <"> <char> <"> | <num>
static long int unary(doit
)
if (digval
[nxtchr
[1]] != DIGIT_O
|| digval
[nxtchr
[2]] != DIGIT_T
)
case '!': deblank1
; return !unary(doit
);
case '~': deblank1
; return ~unary(doit
);
case '-': deblank1
; return -unary(doit
);
case '+': deblank1
; return unary(doit
);
case '(': deblank1
; v
= query(doit
);
if (nxtchr
[0] != ')') experr("Bad factor");
case '\"': return charcon(doit
);
case '0': case '1': case '2':
case '3': case '4': case '5':
case '6': case '7': case '8':
case '9': return numcon(doit
);
default : experr("Bad constant");
/* <term> ::= <unary> { <mulop> <unary> }
<mulop> ::= '*' | '/' || '%'
static long int term(doit
)
register long int vl
, vr
;
if (digval
[nxtchr
[1]] != DIGIT_I
|| digval
[nxtchr
[2]] != DIGIT_V
)
if (vr
== 0) experr("Division by 0");
if (digval
[nxtchr
[1]] != DIGIT_O
|| digval
[nxtchr
[2]] != DIGIT_D
)
/* <primary> ::= <term> { <addop> <term> }
static long int primary(doit
)
if (doit
) vl
+= term(doit
); else (void)term(doit
);
if (doit
) vl
-= term(doit
); else (void)term(doit
);
/* <shift> ::= <primary> { <shop> <primary> }
static long int shift(doit
)
register long int vl
, vr
;
if (nxtchr
[0] == '<' && nxtchr
[1] == '<') {
if (nxtchr
[0] == '>' && nxtchr
[1] == '>') {
/* The following code implements shifts portably */
/* Shifts are signed shifts, and the shift count */
/* acts like repeated one-bit shifts, not modulo anything */
vl
= (vl
>> -vr
) | (-(vl
< 0) << (LONG_BIT
+ vr
));
/* <relat> ::= <shift> { <rel> <shift> }
<rel> ::= '<=' | '>=' | '=<' | '=>' | '<' | '>'
Here I rely on the fact that '<<' and '>>' are swallowed by <shift>
static long int relat(doit
)
case '<': /* =<, take as <= */
case '>': /* =>, take as >= */
default: /* == or =; OOPS */
if (nxtchr
[1] == '=') { /* <= */
if (nxtchr
[1] == '>') { /* <> (Pascal) */
if (nxtchr
[1] == '=') { /* >= */
/* <eql> ::= <relat> { <eqrel> <relat> }
<eqlrel> ::= '!=' | '==' | '='
static long int eql(doit
)
if (nxtchr
[0] == '!' && nxtchr
[1] == '=') {
if (nxtchr
[0] == '=' && nxtchr
[1] == '=') {
/* <band> ::= <eql> { '&' <eql> }
static long int band(doit
)
while (nxtchr
[0] == '&' && nxtchr
[1] != '&') {
if (doit
) vl
&= eql(doit
); else (void)eql(doit
);
/* <bxor> ::= <band> { '^' <band> }
static long int bxor(doit
)
while (nxtchr
[0] == '^') {
if (doit
) vl
^= band(doit
); else (void)band(doit
);
/* <bor> ::= <bxor> { '|' <bxor> }
static long int bor(doit
)
while (nxtchr
[0] == '|' && nxtchr
[1] != '|') {
if (doit
) vl
|= bxor(doit
); else (void)bxor(doit
);
/* <land> ::= <bor> { '&&' <bor> }
static long int land(doit
)
if (nxtchr
[1] != '&') break;
if (digval
[nxtchr
[0]] == DIGIT_A
) {
if (digval
[nxtchr
[1]] != DIGIT_N
) break;
if (digval
[nxtchr
[2]] != DIGIT_D
) break;
vl
= bor(doit
&& vl
) != 0;
/* <lor> ::= <land> { '||' <land> }
static long int lor(doit
)
if (nxtchr
[1] != '|') break;
if (digval
[nxtchr
[0]] == DIGIT_O
) {
if (digval
[nxtchr
[1]] != DIGIT_R
) break;
vl
= land(doit
&& !vl
) != 0;
/* <query> ::= <lor> [ '?' <query> ':' <query> ]
static long int query(doit
)
register long int bool, true_val
, false_val
;
if (*nxtchr
!= '?') return bool;
true_val
= query(doit
&& bool);
if (*nxtchr
!= ':') experr("Bad query");
false_val
= query(doit
&& !bool);
return bool ? true_val
: false_val
;
static void initialise_digval()
register unsigned char *s
;
for (c
= 0; c
<= UCHAR_MAX
; c
++) digval
[c
] = 99;
for (c
= 0, s
= (unsigned char *)"0123456789";
/*doing*/ digval
[*s
++] = c
++) /* skip */;
for (c
= 10, s
= (unsigned char *)"ABCDEFGHIJKLMNOPQRSTUVWXYZ";
/*doing*/ digval
[*s
++] = c
++) /* skip */;
for (c
= 10, s
= (unsigned char *)"abcdefghijklmnopqrstuvwxyz";
/*doing*/ digval
[*s
++] = c
++) /* skip */;
if (digval
['1'] == 0) initialise_digval();
nxtchr
= (unsigned char *)expbuf
;
if (setjmp(expjump
) != 0) return FALSE
;
if (*nxtchr
) experr("Ill-formed expression");