usr/src/lib/libshell/common/sh/streval.c

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