1
0
Fork 0
mirror of git://git.code.sf.net/p/cdesktopenv/code synced 2025-03-09 15:50:02 +00:00
cde/src/cmd/ksh93/sh/streval.c
Martijn Dekker 148a8a3f46 Another build system overhaul (re: 35672208, 580ff616, 6cc2f6a0)
So far we've been handling AST release build and git commit flags
and ksh SHOPT_* compile time options in the generic package build
script. That was a hack that was necessary before I had sufficient
understanding of the build system. Some of it did not work very
well, e.g. the correct git commit did not show up in ${.sh.version}
when compiling from a git repo.

As of this commit, this is properly included in the mamake
dependency tree by handling it from the libast and ksh93 Mamfiles,
guaranteeing they are properly up to date.

For a release build, the _AST_ksh_release macro is renamed to
_AST_release, because some aspects of libast also use this.

This commit also adds my first attempt at documenting the (very
simple, six-command) mamake language as it is currently implemented
-- which is significantly different from Glenn Fowler's original
paper. This is mostly based on reading the mamake.c source code.

src/cmd/INIT/README-mamake.md:
- Added.

bin/package, src/cmd/INIT/package.sh:
- Delete the hack.

**/Mamfile:
- Remove KSH_RELFLAGS and KSH_SHOPTFLAGS, which supported the hack.
- Delete 'meta' commands. They were no-ops; mamake.c ignores them.
  They also did not add any informative value.

src/lib/libast/Mamfile:
- Add a 'virtual' target that obtains the current git commit,
  examines the git branch, and decides whether to auto-set an
  _AST_git_commit and/or or _AST_release #define to a new
  releaseflags.h header file. This is overwritten on each run.
- Add code to the install target that copies limit.h to
  include/ast, but only if it doesn't exist or the content of the
  original changed. This allows '#include <releaseflags.h>' from
  any program using libast while avoiding needless recompiles.
- When there are uncommitted changes, add /MOD (modified) to the
  commit hash instead of not defining it at all.

src/cmd/ksh93/**:
- Mamfile: Add a shopt.h target that reads SHOPT.sh and converts it
  into a new shopt.h header file in the object code directory. The
  shopt.h header only contains SHOPT_* directives that have a value
  in SHOPT.sh (not the empty/probe ones). They also do not redefine
  the macros if they already exist, so overriding with something
  like CCFLAGS+=' -DSHOPT_FOO=1' remains possible.
- **.c: Every c file now #includes "shopt.h" first. So SHOPT_*
  macros are no longer passed via environment/MAM variables.
* SHOPT.sh: The AUDITFILE and CMDLIB_DIR macros no longer need an
  extra backslash-escape for the double quotes in their values.
  (The old way required this because mamake inserts MAM variables
  directly into shell scripts as literals without quoting.  :-/ )

src/cmd/INIT/mamake.c:
- Import the two minor changes between from 93u+ and 93v-: bind()
  is renamed to bindfile() and there is a tweak to detecting an
  "improper done statement".
- Allow arbitrary whitespace (isspace()) everywhere, instead of
  spaces only. This obsoletes my earlier indentation workaround
  from 6cc2f6a0; turns out mamake always supported indentation, but
  with spaces only.
- Do not skip line numbers at the beginning of each line. This
  undocumented feature is not and (AFAICT) never has been used.
- Throw an error on unknown command or rule attribute. Quite an
  important feature for manual maintenance: catches typos, etc.
2022-06-12 05:47:02 +01:00

1015 lines
22 KiB
C

/***********************************************************************
* *
* This software is part of the ast package *
* Copyright (c) 1982-2012 AT&T Intellectual Property *
* Copyright (c) 2020-2022 Contributors to ksh 93u+m *
* and is licensed under the *
* Eclipse Public License, Version 1.0 *
* by AT&T Intellectual Property *
* *
* A copy of the License is available at *
* http://www.eclipse.org/org/documents/epl-v10.html *
* (with md5 checksum b35adb5213ca9657e911e9befb180842) *
* *
* Information and Software Systems Research *
* AT&T Research *
* Florham Park NJ *
* *
* David Korn <dgk@research.att.com> *
* *
***********************************************************************/
/*
* D. G. Korn
* AT&T Labs
*
* arithmetic expression evaluator
*
* this version compiles the expression onto a stack
* and has a separate executor
*/
#include "shopt.h"
#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 1024
#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))))
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 Sfdouble_t (*Math_f)(Sfdouble_t,...);
typedef Sfdouble_t (*Math_1f_f)(Sfdouble_t);
typedef int (*Math_1i_f)(Sfdouble_t);
typedef Sfdouble_t (*Math_2f_f)(Sfdouble_t,Sfdouble_t);
typedef Sfdouble_t (*Math_2f_i)(Sfdouble_t,int);
typedef int (*Math_2i_f)(Sfdouble_t,Sfdouble_t);
typedef Sfdouble_t (*Math_3f_f)(Sfdouble_t,Sfdouble_t,Sfdouble_t);
typedef int (*Math_3i_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 = "";
return(0);
}
static void arith_error(const char *message,const char *expr, int mode)
{
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],arg[9];
const char *ptr = "";
char *lastval=0;
int lastsub;
Math_f fun;
struct lval node;
node.emode = ep->emode;
node.expr = ep->expr;
node.elen = ep->elen;
node.value = 0;
node.nosub = 0;
node.sub = 0;
node.ptr = 0;
node.eflag = 0;
if(sh.arithrecursion++ >= 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:
node.nosub = -1;
(*ep->fun)(&ptr,&node,ASSIGN,num+1);
break;
case A_MINUSMINUS:
node.nosub = -1;
(*ep->fun)(&ptr,&node,ASSIGN,num-1);
break;
case A_INCR:
num = num+1;
node.nosub = -1;
num = (*ep->fun)(&ptr,&node,ASSIGN,num);
break;
case A_DECR:
num = num-1;
node.nosub = -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_ASSIGNOP1:
node.emode |= ARITH_ASSIGNOP;
/* FALLTHROUGH */
case A_PUSHV:
cp = roundptr(ep,cp,Sfdouble_t*);
dp = *((Sfdouble_t**)cp);
cp += sizeof(Sfdouble_t*);
c = *(short*)cp;
cp += sizeof(short);
lastval = node.value = (char*)dp;
if(node.flag = c)
lastval = 0;
node.isfloat=0;
node.level = sh.arithrecursion;
node.nosub = 0;
num = (*ep->fun)(&ptr,&node,VALUE,num);
if(node.emode&ARITH_ASSIGNOP)
{
lastsub = node.nosub;
node.nosub = 0;
node.emode &= ~ARITH_ASSIGNOP;
}
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_ENUM:
node.eflag = 1;
continue;
case A_ASSIGNOP:
node.nosub = lastsub;
/* FALLTHROUGH */
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;
if(lastval)
node.eflag = 1;
node.ptr = 0;
num = (*ep->fun)(&ptr,&node,ASSIGN,num);
if(lastval && node.ptr)
{
Sfdouble_t r;
node.flag = 0;
node.value = lastval;
r = (*ep->fun)(&ptr,&node,VALUE,num);
if(r!=num)
{
node.flag=c;
node.value = (char*)dp;
num = (*ep->fun)(&ptr,&node,ASSIGN,r);
}
}
lastval = 0;
c=0;
break;
case A_PUSHF:
cp = roundptr(ep,cp,Math_f);
*++sp = (Sfdouble_t)(cp-ep->code);
cp += sizeof(Math_f);
*++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_CALL1F:
sp--,tp--;
fun = *((Math_f*)(ep->code+(int)(*sp)));
type = *tp;
if(c&T_BINARY)
{
c &= ~T_BINARY;
arg[0] = num;
arg[1] = 0;
num = sh_mathfun((void*)fun,1,arg);
break;
}
num = (*((Math_1f_f)fun))(num);
break;
case A_CALL1I:
sp--,tp--;
fun = *((Math_f*)(ep->code+(int)(*sp)));
type = *tp;
num = (*((Math_1i_f)fun))(num);
break;
case A_CALL2F:
sp-=2,tp-=2;
fun = *((Math_f*)(ep->code+(int)(*sp)));
type = *tp;
if(c&T_BINARY)
{
c &= ~T_BINARY;
arg[0] = sp[1];
arg[1] = num;
arg[2] = 0;
num = sh_mathfun((void*)fun,2,arg);
break;
}
if(c&T_NOFLOAT)
num = (*((Math_2f_i)fun))(sp[1],(int)num);
else
num = (*((Math_2f_f)fun))(sp[1],num);
break;
case A_CALL2I:
sp-=2,tp-=2;
fun = *((Math_f*)(ep->code+(int)(*sp)));
type = *tp;
num = (*((Math_2i_f)fun))(sp[1],num);
break;
case A_CALL3F:
sp-=3,tp-=3;
fun = *((Math_f*)(ep->code+(int)(*sp)));
type = *tp;
if(c&T_BINARY)
{
c &= ~T_BINARY;
arg[0] = sp[1];
arg[1] = sp[2];
arg[2] = num;
arg[3] = 0;
num = sh_mathfun((void*)fun,3,arg);
break;
}
num = (*((Math_3f_f)fun))(sp[1],sp[2],num);
break;
}
if(c)
lastval = 0;
if(c&T_BINARY)
{
node.ptr = 0;
sp--,tp--;
type |= (*tp!=0);
}
*sp = num;
*tp = type;
}
if(sh.arithrecursion>0)
sh.arithrecursion--;
if(type==0 && !num)
num = 0;
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;
case A_COMMA:
if(sh.radixpoint==',' && (c=peekchr(vp))>='0' && c<='9')
{
op = A_DIG;
goto keep;
}
break;
case A_DOT:
if((c=peekchr(vp))>='0' && c<='9')
op = A_DIG;
else
op = A_REG;
/* FALLTHROUGH */
case A_DIG: case A_REG: case A_LIT:
keep:
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;
}
/* FALLTHROUGH */
case A_NOT: case A_COLON:
c = '=';
/* FALLTHROUGH */
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.nargs = 0;
lvalue.fun = 0;
again:
op = gettok(vp);
c = 2*MAXPREC+1;
switch(op)
{
case A_PLUS:
goto again;
case A_EOF:
if(precedence>2)
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;
/* FALLTHROUGH */
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;
if(op==A_EQ || op==A_NEQ)
stakputc(A_ENUM);
stakputc(assignop.value?A_ASSIGNOP1: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_number);
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))
{
stakseek(staktell()-1);
return(0);
}
lvalue.value = 0;
break;
case A_LPAR:
{
int infun = vp->infun;
int userfun=0;
Sfdouble_t (*fun)(Sfdouble_t,...);
int nargs = lvalue.nargs;
if(nargs<0)
nargs = -nargs;
fun = lvalue.fun;
lvalue.fun = 0;
if(fun)
{
if(vp->staksize++>=vp->stakmaxsize)
vp->stakmaxsize = vp->staksize;
vp->infun=1;
if((int)lvalue.nargs<0)
userfun = T_BINARY;
else if((int)lvalue.nargs&040)
userfun = T_NOFLOAT;
stakputc(A_PUSHF);
stakpush(vp,fun,Math_f);
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&010)?2:-1;
nargs &= 7;
if(vp->infun != nargs)
ERROR(vp,e_argcount);
if((vp->staksize+=nargs)>=vp->stakmaxsize)
vp->stakmaxsize = vp->staksize+nargs;
stakputc(A_CALL1F+userfun+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;
/* FALLTHROUGH */
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;
/* FALLTHROUGH */
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(c&1?A_ASSIGNOP: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.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;
if((*fun)( &string , &cur.errmsg, MESSAGE, 0) < 0)
{
stakseek(0);
*last = (char*)Empty;
return(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 arith_strval()
*/
Sfdouble_t arith_strval(const char *s, char **end, Sfdouble_t(*convert)(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,convert,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 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);
}
errormsg(SH_DICT,ERROR_exit(1),message,ep->name);
UNREACHABLE();
}
#undef extern
#endif /* _mem_name_exception */