1: /*
     2:  * Focal, 1981.
     3:  * Expression evaluation.
     4:  */
     5: #include "focal.h"
     6: 
     7: /*
     8:  * Evaluate an expression.
     9:  */
    10: double
    11: eval()
    12: {
    13:         double          val;
    14:         double          rop;
    15:         register int    c;
    16: 
    17:         if ((c=getnb())=='+' || c=='-') {
    18:                 val = primary();
    19:                 if (c == '-')
    20:                         val = -val;
    21:         } else {
    22:                 --ctp;
    23:                 val = primary();
    24:         }
    25:         while ((c=getnb())=='+' || c=='-') {
    26:                 rop = primary();
    27:                 if (c == '+')
    28:                         val = val + rop;
    29:                 else
    30:                         val = val - rop;
    31:         }
    32:         --ctp;
    33:         return (val);
    34: }
    35: 
    36: double
    37: primary()
    38: {
    39:         double          val;
    40:         double          rop;
    41:         register int    c;
    42: 
    43:         val = term();
    44:         while ((c = getnb())=='*' || c=='/' || c=='^') {
    45:                 rop = term();
    46:                 if (c == '*')
    47:                         val = val * rop;
    48:                 else if (c == '/')
    49:                         val = val / rop;
    50:                 else 
    51:                         val = pow(val, rop);
    52:         }
    53:         --ctp;
    54:         return (val);
    55: }
    56: 
    57: double
    58: term()
    59: {
    60:         register int    c;
    61:         register char   *cp;
    62:         double          val;
    63:         register int    fsign;
    64:         register int    fdot;
    65:         register int    fexp;
    66:         register int    type;
    67:         register int    subs = 0;
    68:         register struct sym     *sp;
    69:         char            id[NID];
    70:         char            nbuf[20];
    71: 
    72:         if ((c = getnb())=='(' || c=='[' || c=='<') {
    73:                 val = eval();
    74:                 if (++c != ')')
    75:                         ++c;
    76:                 if (c != getnb())
    77:                         diag("Mismatched enclosures");
    78:                 return (val);
    79:         }
    80:         if (c=='.' || isdigit(c)) {
    81:                 fsign = 1;
    82:                 fexp = 0;
    83:                 fdot = 0;
    84:                 if (c == '.')
    85:                         ++fdot;
    86:                 cp = &nbuf[0];
    87:                 for (;;) {
    88:                         if (cp >= &nbuf[19])
    89:                                 diag("Number too long");
    90:                         *cp++ = c;
    91:                         if ((c = *ctp++) == '.') {
    92:                                 if (fdot++)
    93:                                         break;
    94:                         } else if (c == 'e') {
    95:                                 if (fexp++)
    96:                                         break;
    97:                                 fsign = 0;
    98:                                 fdot = 1;
    99:                         } else if (c=='+' || c=='-') {
   100:                                 if (fsign++)
   101:                                         break;
   102:                         } else if (!isdigit(c))
   103:                                 break;
   104:                 }
   105:                 --ctp;
   106:                 *cp = '\0';
   107:                 return (atof(nbuf));
   108:         }
   109:         if (!isalpha(c))
   110:                 diag("Expression syntax");
   111:         cp = &id[0];
   112:         do {
   113:                 if (cp < &id[NID-1])
   114:                         *cp++ = c;
   115:                 c = *ctp++;
   116:         } while (isalnum(c));
   117:         *cp = 0;
   118: #ifdef FUNCTIONS
   119:         if (id[0]=='f' && (sp=lookup(id, S_FUNC, 0))!=NULL) {
   120:                 while (c==' ' || c=='\t')
   121:                         c = *ctp++;
   122:                 if (c != '(')
   123:                         diag("Missing `(' for function");
   124:                 val = eval();
   125:                 if (getnb() != ')')
   126:                         diag("Missing `)' for function");
   127:                 return ((*sp->s_un.s_fp)(val));
   128:         }
   129: #endif
   130:         type = S_SCAL;
   131:         while (c==' ' || c=='\t')
   132:                 c = *ctp++;
   133:         if (c == '(') {
   134:                 type = S_ARRAY;
   135:                 subs = (int) eval();
   136:                 if (getnb() != ')')
   137:                         diag("Missing ) in subscript");
   138:         } else
   139:                 --ctp;
   140:         if ((sp=lookup(id, type, subs)) == NULL)
   141:                 diag("Undefined variable");
   142:         return (sp->s_un.s_value);
   143: }
   144: 
   145: 
   146: struct  sym *
   147: lookup(id, type, subs)
   148: char *id;
   149: register type;
   150: int     subs;
   151: {
   152:         register struct sym *sp;
   153:         int     ix;
   154:         
   155:         ix = hashsym(id, type, subs);
   156:         sp = symv[ix];
   157:         while (sp != NULL) {
   158:                 if (sp->s_type == type
   159:                 && (type!=S_ARRAY || sp->s_subs==subs)
   160:                 &&  strcmp(id, sp->s_id) == 0)
   161:                         break;
   162:                 sp = sp->s_fp;
   163:         }
   164:         return (sp);
   165: }
   166: 
   167: struct sym *
   168: getsym()
   169: {
   170:         register int c;
   171:         char id[NID];
   172:         register char *cp;
   173:         register struct sym *sp;
   174:         int subs = 0, type;
   175:         int     ix;
   176:         
   177:         if (isalpha(c = getnb()) == 0)
   178:                 diag("Missing variable");
   179:         cp = &id[0];
   180:         do {
   181:                 if (cp < &id[NID-1])
   182:                         *cp++ = c;
   183:                 c = *ctp++;
   184:         } while (isalnum(c));
   185:         *cp = 0;
   186:         type = S_SCAL;
   187:         while (c==' ' || c=='\t')
   188:                 c = *ctp++;
   189:         if (c == '(') {
   190:                 type = S_ARRAY;
   191:                 subs = (int) eval();
   192:                 if (getnb() != ')')
   193:                         diag("Bad subscript");
   194:         } else
   195:                 --ctp;
   196:         if ((sp=lookup(id, type, subs)) == NULL) {
   197:                 sp = (struct sym *)malloc(sizeof(*sp)+strlen(id)+1);
   198:                 if (sp == NULL)
   199:                         diag("Out of space (symbols)");
   200:                 ix = hashsym(id, type, subs);
   201:                 sp->s_fp = symv[ix];
   202:                 symv[ix] = sp;
   203:                 sp->s_type = type;
   204:                 sp->s_subs = subs;
   205:                 strcpy(sp->s_id, id);
   206:         }
   207:         return (sp);
   208: }
   209: 
   210: #ifdef FUNCTIONS
   211: double
   212: fsin(arg)
   213: double arg;
   214: {
   215:         return (sin(arg));
   216: }
   217: 
   218: double
   219: fcos(arg)
   220: double arg;
   221: {
   222:         return (cos(arg));
   223: }
   224: 
   225: double
   226: fexp(arg)
   227: double arg;
   228: {
   229:         return (exp(arg));
   230: }
   231: 
   232: double
   233: flog(arg)
   234: double arg;
   235: {
   236:         return (log(arg));
   237: }
   238: 
   239: double
   240: fatn(arg)
   241: double arg;
   242: {
   243:         return (atan(arg));
   244: }
   245: 
   246: double
   247: fsqt(arg)
   248: double arg;
   249: {
   250:         if (arg < 0.0)
   251:                 diag("Fsqt < 0.0");
   252:         return (sqrt(arg));
   253: }
   254: 
   255: double
   256: fabt(arg)
   257: double arg;
   258: {
   259:         if (arg < 0)
   260:                 return (-arg);
   261:         return (arg);
   262: }
   263: 
   264: double
   265: fsgn(arg)
   266: double arg;
   267: {
   268:         if (arg < 0)
   269:                 return (-1.0);
   270:         return (1.0);
   271: }
   272: 
   273: double
   274: fitr(arg)
   275: double arg;
   276: {
   277:         if (arg < 0)
   278:                 return (-floor(-arg));
   279:         if (arg == 0)
   280:                 return (0.0);
   281:         return (floor(arg));
   282: }
   283: 
   284: double
   285: fran(arg)
   286: double arg;
   287: {
   288:         return (drand48());
   289: }
   290: 
   291: #endif