14887Schin /*********************************************************************** 24887Schin * * 34887Schin * This software is part of the ast package * 4*10898Sroland.mainz@nrubsig.org * Copyright (c) 1982-2009 AT&T Intellectual Property * 54887Schin * and is licensed under the * 64887Schin * Common Public License, Version 1.0 * 78462SApril.Chin@Sun.COM * by AT&T Intellectual Property * 84887Schin * * 94887Schin * A copy of the License is available at * 104887Schin * http://www.opensource.org/licenses/cpl1.0.txt * 114887Schin * (with md5 checksum 059e8cd6165cb4c31e351f2b69388fd9) * 124887Schin * * 134887Schin * Information and Software Systems Research * 144887Schin * AT&T Research * 154887Schin * Florham Park NJ * 164887Schin * * 174887Schin * David Korn <dgk@research.att.com> * 184887Schin * * 194887Schin ***********************************************************************/ 204887Schin #pragma prototyped 214887Schin /* 224887Schin * Shell arithmetic - uses streval library 234887Schin * David Korn 244887Schin * AT&T Labs 254887Schin */ 264887Schin 274887Schin #include "defs.h" 284887Schin #include "lexstates.h" 294887Schin #include "name.h" 304887Schin #include "streval.h" 314887Schin #include "variables.h" 324887Schin 334887Schin #ifndef LLONG_MAX 344887Schin #define LLONG_MAX LONG_MAX 354887Schin #endif 364887Schin 378462SApril.Chin@Sun.COM static Sfdouble_t NaN, Inf, Fun; 384887Schin static Namval_t Infnod = 394887Schin { 404887Schin { 0 }, 414887Schin "Inf", 424887Schin NV_NOFREE|NV_LDOUBLE,NV_RDONLY 434887Schin }; 444887Schin 454887Schin static Namval_t NaNnod = 464887Schin { 474887Schin { 0 }, 484887Schin "NaN", 494887Schin NV_NOFREE|NV_LDOUBLE,NV_RDONLY 504887Schin }; 514887Schin 528462SApril.Chin@Sun.COM static Namval_t FunNode = 538462SApril.Chin@Sun.COM { 548462SApril.Chin@Sun.COM { 0 }, 558462SApril.Chin@Sun.COM "?", 568462SApril.Chin@Sun.COM NV_NOFREE|NV_LDOUBLE,NV_RDONLY 578462SApril.Chin@Sun.COM }; 588462SApril.Chin@Sun.COM 598462SApril.Chin@Sun.COM static Namval_t *scope(Shell_t *shp,register Namval_t *np,register struct lval *lvalue,int assign) 604887Schin { 614887Schin register Namarr_t *ap; 624887Schin register int flag = lvalue->flag; 638462SApril.Chin@Sun.COM register char *sub=0, *cp=(char*)np; 648462SApril.Chin@Sun.COM register Namval_t *mp; 658462SApril.Chin@Sun.COM int flags = HASH_NOSCOPE|HASH_SCOPE|HASH_BUCKET; 668462SApril.Chin@Sun.COM Dt_t *sdict = (shp->st.real_fun? shp->st.real_fun->sdict:0); 67*10898Sroland.mainz@nrubsig.org Dt_t *root = shp->var_tree; 688462SApril.Chin@Sun.COM assign = assign?NV_ASSIGN:NV_NOASSIGN; 698462SApril.Chin@Sun.COM if(cp>=lvalue->expr && cp < lvalue->expr+lvalue->elen) 704887Schin { 718462SApril.Chin@Sun.COM int offset; 728462SApril.Chin@Sun.COM /* do binding to node now */ 738462SApril.Chin@Sun.COM int c = cp[flag]; 748462SApril.Chin@Sun.COM cp[flag] = 0; 758462SApril.Chin@Sun.COM if((!(np = nv_open(cp,shp->var_tree,assign|NV_VARNAME|NV_NOADD|NV_NOFAIL)) || nv_isnull(np)) && sh_macfun(shp,cp, offset = staktell())) 764887Schin { 778462SApril.Chin@Sun.COM Fun = sh_arith(sub=stakptr(offset)); 788462SApril.Chin@Sun.COM FunNode.nvalue.ldp = &Fun; 794887Schin cp[flag] = c; 808462SApril.Chin@Sun.COM return(&FunNode); 814887Schin } 82*10898Sroland.mainz@nrubsig.org if(!np && assign) 83*10898Sroland.mainz@nrubsig.org np = nv_open(cp,shp->var_tree,assign|NV_VARNAME); 84*10898Sroland.mainz@nrubsig.org if(!np) 85*10898Sroland.mainz@nrubsig.org return(0); 86*10898Sroland.mainz@nrubsig.org root = shp->last_root; 878462SApril.Chin@Sun.COM cp[flag] = c; 888462SApril.Chin@Sun.COM if(cp[flag+1]=='[') 898462SApril.Chin@Sun.COM flag++; 908462SApril.Chin@Sun.COM else 918462SApril.Chin@Sun.COM flag = 0; 928462SApril.Chin@Sun.COM cp = (char*)np; 938462SApril.Chin@Sun.COM } 94*10898Sroland.mainz@nrubsig.org if((lvalue->emode&ARITH_COMP) && dtvnext(root) && ((mp=nv_search(cp,root,flags))||(sdict && (mp=nv_search(cp,sdict,flags))))) 958462SApril.Chin@Sun.COM { 968462SApril.Chin@Sun.COM while(nv_isref(mp)) 974887Schin { 988462SApril.Chin@Sun.COM sub = nv_refsub(mp); 998462SApril.Chin@Sun.COM mp = nv_refnode(mp); 1004887Schin } 1018462SApril.Chin@Sun.COM np = mp; 1024887Schin } 1034887Schin if(flag || sub) 1044887Schin { 1054887Schin if(!sub) 1064887Schin sub = (char*)&lvalue->expr[flag]; 107*10898Sroland.mainz@nrubsig.org nv_endsubscript(np,sub,NV_ADD|NV_SUBQUOTE); 1084887Schin } 1094887Schin return(np); 1104887Schin } 1114887Schin 1124887Schin static Sfdouble_t arith(const char **ptr, struct lval *lvalue, int type, Sfdouble_t n) 1134887Schin { 1148462SApril.Chin@Sun.COM Shell_t *shp = &sh; 1154887Schin register Sfdouble_t r= 0; 1164887Schin char *str = (char*)*ptr; 1178462SApril.Chin@Sun.COM register char *cp; 1184887Schin switch(type) 1194887Schin { 1204887Schin case ASSIGN: 1214887Schin { 1224887Schin register Namval_t *np = (Namval_t*)(lvalue->value); 1238462SApril.Chin@Sun.COM np = scope(shp,np,lvalue,1); 1244887Schin nv_putval(np, (char*)&n, NV_LDOUBLE); 1254887Schin r=nv_getnum(np); 1264887Schin break; 1274887Schin } 1284887Schin case LOOKUP: 1294887Schin { 1304887Schin register int c = *str; 1314887Schin register char *xp=str; 1324887Schin lvalue->value = (char*)0; 1334887Schin if(c=='.') 1344887Schin str++; 1354887Schin c = mbchar(str); 1364887Schin if(isaletter(c)) 1374887Schin { 1384887Schin register Namval_t *np; 1394887Schin int dot=0; 1404887Schin while(1) 1414887Schin { 1424887Schin while(xp=str, c=mbchar(str), isaname(c)); 1434887Schin str = xp; 1448462SApril.Chin@Sun.COM if(c=='[' && dot==NV_NOADD) 1458462SApril.Chin@Sun.COM { 1468462SApril.Chin@Sun.COM str = nv_endsubscript((Namval_t*)0,str,0); 1478462SApril.Chin@Sun.COM c = *str; 1488462SApril.Chin@Sun.COM } 1494887Schin if(c!='.') 1504887Schin break; 1518462SApril.Chin@Sun.COM dot=NV_NOADD; 1524887Schin if((c = *++str) !='[') 1534887Schin continue; 1544887Schin str = nv_endsubscript((Namval_t*)0,cp=str,NV_SUBQUOTE)-1; 1554887Schin if(sh_checkid(cp+1,(char*)0)) 1564887Schin str -=2; 1574887Schin } 1584887Schin if(c=='(') 1594887Schin { 1604887Schin int fsize = str- (char*)(*ptr); 1614887Schin const struct mathtab *tp; 1624887Schin c = **ptr; 1634887Schin lvalue->fun = 0; 1644887Schin if(fsize<=(sizeof(tp->fname)-2)) for(tp=shtab_math; *tp->fname; tp++) 1654887Schin { 1664887Schin if(*tp->fname > c) 1674887Schin break; 1684887Schin if(tp->fname[1]==c && tp->fname[fsize+1]==0 && strncmp(&tp->fname[1],*ptr,fsize)==0) 1694887Schin { 1704887Schin lvalue->fun = tp->fnptr; 1714887Schin lvalue->nargs = *tp->fname; 1724887Schin break; 1734887Schin } 1744887Schin } 1754887Schin if(lvalue->fun) 1764887Schin break; 1774887Schin lvalue->value = (char*)ERROR_dictionary(e_function); 1784887Schin return(r); 1794887Schin } 1804887Schin if((lvalue->emode&ARITH_COMP) && dot) 1814887Schin { 1824887Schin lvalue->value = (char*)*ptr; 1834887Schin lvalue->flag = str-lvalue->value; 1844887Schin break; 1854887Schin } 1864887Schin *str = 0; 1874887Schin if(sh_isoption(SH_NOEXEC)) 1884887Schin np = L_ARGNOD; 1894887Schin else 1904887Schin { 1914887Schin int offset = staktell(); 1924887Schin char *saveptr = stakfreeze(0); 1938462SApril.Chin@Sun.COM Dt_t *root = (lvalue->emode&ARITH_COMP)?shp->var_base:shp->var_tree; 1944887Schin *str = c; 1954887Schin while(c=='[' || c=='.') 1964887Schin { 1974887Schin if(c=='[') 1984887Schin { 1994887Schin str = nv_endsubscript(np,cp=str,0); 2004887Schin if((c= *str)!='[' && c!='.') 2014887Schin { 2024887Schin str = cp; 2034887Schin c = '['; 2044887Schin break; 2054887Schin } 2064887Schin } 2074887Schin else 2084887Schin { 2098462SApril.Chin@Sun.COM dot = NV_NOADD|NV_NOFAIL; 2104887Schin str++; 2114887Schin while(xp=str, c=mbchar(str), isaname(c)); 2124887Schin str = xp; 2134887Schin } 2144887Schin } 2154887Schin *str = 0; 2168462SApril.Chin@Sun.COM cp = (char*)*ptr; 2178462SApril.Chin@Sun.COM if ((cp[0] == 'i' || cp[0] == 'I') && (cp[1] == 'n' || cp[1] == 'N') && (cp[2] == 'f' || cp[2] == 'F') && cp[3] == 0) 2184887Schin { 2198462SApril.Chin@Sun.COM Inf = strtold("Inf", NiL); 2204887Schin Infnod.nvalue.ldp = &Inf; 2214887Schin np = &Infnod; 2224887Schin } 2238462SApril.Chin@Sun.COM else if ((cp[0] == 'n' || cp[0] == 'N') && (cp[1] == 'a' || cp[1] == 'A') && (cp[2] == 'n' || cp[2] == 'N') && cp[3] == 0) 2244887Schin { 2258462SApril.Chin@Sun.COM NaN = strtold("NaN", NiL); 2264887Schin NaNnod.nvalue.ldp = &NaN; 2274887Schin np = &NaNnod; 2284887Schin } 2298462SApril.Chin@Sun.COM else if(!(np = nv_open(*ptr,root,NV_NOASSIGN|NV_VARNAME|dot))) 2308462SApril.Chin@Sun.COM { 2318462SApril.Chin@Sun.COM lvalue->value = (char*)*ptr; 2328462SApril.Chin@Sun.COM lvalue->flag = str-lvalue->value; 2338462SApril.Chin@Sun.COM } 2344887Schin if(saveptr != stakptr(0)) 2354887Schin stakset(saveptr,offset); 2364887Schin else 2374887Schin stakseek(offset); 2384887Schin } 2394887Schin *str = c; 2408462SApril.Chin@Sun.COM if(!np && lvalue->value) 2418462SApril.Chin@Sun.COM break; 2424887Schin lvalue->value = (char*)np; 243*10898Sroland.mainz@nrubsig.org /* bind subscript later */ 244*10898Sroland.mainz@nrubsig.org if(nv_isattr(np,NV_DOUBLE)==NV_DOUBLE) 245*10898Sroland.mainz@nrubsig.org lvalue->isfloat=1; 246*10898Sroland.mainz@nrubsig.org lvalue->flag = 0; 247*10898Sroland.mainz@nrubsig.org if(c=='[') 2484887Schin { 249*10898Sroland.mainz@nrubsig.org lvalue->flag = (str-lvalue->expr); 250*10898Sroland.mainz@nrubsig.org do 251*10898Sroland.mainz@nrubsig.org str = nv_endsubscript(np,str,0); 252*10898Sroland.mainz@nrubsig.org while((c= *str)=='['); 2534887Schin break; 2544887Schin } 2554887Schin } 2564887Schin else 2574887Schin { 2584887Schin char lastbase=0, *val = xp, oerrno = errno; 2594887Schin errno = 0; 2604887Schin r = strtonll(val,&str, &lastbase,-1); 2614887Schin if(*str=='8' || *str=='9') 2624887Schin { 2634887Schin lastbase=10; 2644887Schin errno = 0; 2654887Schin r = strtonll(val,&str, &lastbase,-1); 2664887Schin } 2674887Schin if(lastbase<=1) 2684887Schin lastbase=10; 2694887Schin if(*val=='0') 2704887Schin { 2714887Schin while(*val=='0') 2724887Schin val++; 2734887Schin if(*val==0 || *val=='.' || *val=='x' || *val=='X') 2744887Schin val--; 2754887Schin } 2764887Schin if(r==LLONG_MAX && errno) 2774887Schin c='e'; 2784887Schin else 2794887Schin c = *str; 2808462SApril.Chin@Sun.COM if(c==GETDECIMAL(0) || c=='e' || c == 'E' || lastbase == 2818462SApril.Chin@Sun.COM 16 && (c == 'p' || c == 'P')) 2824887Schin { 2834887Schin lvalue->isfloat=1; 2844887Schin r = strtold(val,&str); 2854887Schin } 2864887Schin else if(lastbase==10 && val[1]) 2874887Schin { 2884887Schin if(val[2]=='#') 2894887Schin val += 3; 2904887Schin if((str-val)>2*sizeof(Sflong_t)) 2914887Schin { 2924887Schin Sfdouble_t rr; 2934887Schin rr = strtold(val,&str); 2944887Schin if(rr!=r) 2954887Schin { 2964887Schin r = rr; 2974887Schin lvalue->isfloat=1; 2984887Schin } 2994887Schin } 3004887Schin } 3014887Schin errno = oerrno; 3024887Schin } 3034887Schin break; 3044887Schin } 3054887Schin case VALUE: 3064887Schin { 3074887Schin register Namval_t *np = (Namval_t*)(lvalue->value); 3084887Schin if(sh_isoption(SH_NOEXEC)) 3094887Schin return(0); 3108462SApril.Chin@Sun.COM np = scope(shp,np,lvalue,0); 311*10898Sroland.mainz@nrubsig.org if(!np) 312*10898Sroland.mainz@nrubsig.org { 313*10898Sroland.mainz@nrubsig.org if(sh_isoption(SH_NOUNSET)) 314*10898Sroland.mainz@nrubsig.org { 315*10898Sroland.mainz@nrubsig.org *ptr = lvalue->value; 316*10898Sroland.mainz@nrubsig.org goto skip; 317*10898Sroland.mainz@nrubsig.org } 318*10898Sroland.mainz@nrubsig.org return(0); 319*10898Sroland.mainz@nrubsig.org } 3204887Schin if(((lvalue->emode&2) || lvalue->level>1 || sh_isoption(SH_NOUNSET)) && nv_isnull(np) && !nv_isattr(np,NV_INTEGER)) 3214887Schin { 3224887Schin *ptr = nv_name(np); 323*10898Sroland.mainz@nrubsig.org skip: 3244887Schin lvalue->value = (char*)ERROR_dictionary(e_notset); 3254887Schin lvalue->emode |= 010; 3264887Schin return(0); 3274887Schin } 3284887Schin r = nv_getnum(np); 3294887Schin if(nv_isattr(np,NV_INTEGER|NV_BINARY)==(NV_INTEGER|NV_BINARY)) 3304887Schin lvalue->isfloat= (r!=(Sflong_t)r); 3318462SApril.Chin@Sun.COM else if(nv_isattr(np,NV_DOUBLE)==NV_DOUBLE) 3324887Schin lvalue->isfloat=1; 3334887Schin return(r); 3344887Schin } 3354887Schin 3364887Schin case MESSAGE: 3374887Schin sfsync(NIL(Sfio_t*)); 3384887Schin #if 0 3394887Schin if(warn) 3404887Schin errormsg(SH_DICT,ERROR_warn(0),lvalue->value,*ptr); 3414887Schin else 3424887Schin #endif 3434887Schin errormsg(SH_DICT,ERROR_exit((lvalue->emode&3)!=0),lvalue->value,*ptr); 3444887Schin } 3454887Schin *ptr = str; 3464887Schin return(r); 3474887Schin } 3484887Schin 3494887Schin /* 3504887Schin * convert number defined by string to a Sfdouble_t 3514887Schin * ptr is set to the last character processed 3524887Schin * if mode>0, an error will be fatal with value <mode> 3534887Schin */ 3544887Schin 3554887Schin Sfdouble_t sh_strnum(register const char *str, char** ptr, int mode) 3564887Schin { 3574887Schin register Sfdouble_t d; 3584887Schin char base=0, *last; 3594887Schin if(*str==0) 3604887Schin { 3614887Schin if(ptr) 3624887Schin *ptr = (char*)str; 3634887Schin return(0); 3644887Schin } 3654887Schin errno = 0; 3664887Schin d = strtonll(str,&last,&base,-1); 3674887Schin if(*last || errno) 3684887Schin { 3698462SApril.Chin@Sun.COM if(!last || *last!='.' || last[1]!='.') 3708462SApril.Chin@Sun.COM d = strval(str,&last,arith,mode); 3714887Schin if(!ptr && *last && mode>0) 3724887Schin errormsg(SH_DICT,ERROR_exit(1),e_lexbadchar,*last,str); 3734887Schin } 3748462SApril.Chin@Sun.COM else if (!d && *str=='-') 3758462SApril.Chin@Sun.COM d = -0.0; 3764887Schin if(ptr) 3774887Schin *ptr = last; 3784887Schin return(d); 3794887Schin } 3804887Schin 3814887Schin Sfdouble_t sh_arith(register const char *str) 3824887Schin { 3834887Schin return(sh_strnum(str, (char**)0, 1)); 3844887Schin } 3854887Schin 3864887Schin void *sh_arithcomp(register char *str) 3874887Schin { 3884887Schin const char *ptr = str; 3894887Schin Arith_t *ep; 3904887Schin ep = arith_compile(str,(char**)&ptr,arith,ARITH_COMP|1); 3914887Schin if(*ptr) 3924887Schin errormsg(SH_DICT,ERROR_exit(1),e_lexbadchar,*ptr,str); 3934887Schin return((void*)ep); 3944887Schin } 395