home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / FORMULC.ZIP / FORMULC.C next >
Encoding:
C/C++ Source or Header  |  1994-08-23  |  18.2 KB  |  711 lines
  1. /*FORMULC.C 2.1           as of 8\18\94        */
  2. /*A fast interpreter of mathematical functions */
  3.  
  4. /*Copyright (c) 1994 by Harald Helfgott        */
  5. /* This program must be distributed with its corresponding README.DOC */
  6. /* The full copyright and availability notice is in README.DOC          */
  7. /*     This program is provided "as is", without any explicit or */
  8. /* implicit warranty. */
  9.  
  10.  
  11. /* Programmer's Address:
  12.         Harald Helfgott
  13.         MB 1807, Brandeis University
  14.         P.O. Box 9110
  15.         Waltham, MA 02254-9110
  16.            OR
  17.          (during the summer)
  18.         2606 Willett Apt. 427
  19.         Laramie, Wyoming 82070
  20.         seiere@uwyo.edu */
  21. #include <math.h>
  22. #include <string.h>
  23. #include <stdlib.h>
  24. #include <stdio.h>
  25. #include <stdarg.h>
  26. #include <errno.h>
  27. #include <ctype.h>
  28. #include "formulc.h"
  29.  
  30. #undef FORMU_DEBUG_ON
  31. /* Substitute #define for #undef to trace evaluation */
  32. #ifdef FORMU_DEBUG_ON
  33.  #define DBG(anything)  anything
  34. #else
  35.  #define DBG(anything) /* nothing */
  36. #endif
  37.  
  38. static double pi(void);
  39.  
  40. static double value(UCHAR *function);
  41.  
  42. static CHAR *i_error; /*pointer to the character in source[]
  43.             that causes an error */
  44. static UCHAR *i_trans(UCHAR *function, CHAR *begin, CHAR *end);
  45. static CHAR  *my_strtok(CHAR *s);
  46. static UCHAR *comp_time(UCHAR *function, UCHAR *fend, int npars);
  47.  
  48. static double param['z'-'a'+1];
  49. struct formu_item {
  50.      CHAR *name;
  51.     void *f;    /* pointer to function*/
  52.     int n_pars; /* number of parameters (0, 1, 2 or 3) */
  53. };
  54. #define TABLESIZE 256
  55. #define STD_LIB_NUM 12
  56. static struct formu_item ftable[TABLESIZE]=
  57.        {{"exp",(void *) exp,1},
  58.     {"ln", (void *) log,1},
  59.     {"sin",(void *) sin,1},
  60.     {"cos",(void *) cos,1},
  61.     {"tan",(void *) tan,1},
  62.     {"asin",(void *) asin,1},
  63.     {"acos",(void *) acos,1},
  64.     {"atan",(void *) atan,1},
  65.     {"atan2",(void *) atan2,2},
  66.     {"abs", (void *) fabs,1},
  67.     {"sqrt", (void *) sqrt,1},
  68.     {"pi", (void *) pi,0},
  69.     {NULL,NULL,0}};
  70.  
  71. int read_table(int i, CHAR *name, int *n_pars)
  72. /* returns 1 if succesful */
  73. /* returns 0 otherwise */
  74. {
  75.  if(!ftable[i].f)
  76.   return 0;
  77.  else {
  78.   strcpy(name,ftable[i].name);
  79.   *n_pars=ftable[i].n_pars;
  80.   return 1;
  81.  }
  82. }
  83.  
  84. int where_table(CHAR *name)
  85. /* If the function exists, where_table() returns the index of its name
  86.     in the table. Otherwise, it returns -1. */
  87. {
  88.  struct formu_item *table_p;
  89.  
  90.  for(table_p=ftable; table_p->f != NULL &&
  91.     strcmp(name,table_p->name); table_p++)
  92.    ;
  93.  if(table_p->f == NULL) /*The end of the table has been reached,
  94.          but name[] is not there. */
  95.   return -1;
  96.  else return table_p - ftable;
  97. }
  98.  
  99. int fdel(CHAR *name)
  100. /* If the function exists, it is deleted and a non-negative value
  101.     is returned. */
  102. /* Otherwise, -1 is returned. */
  103. /* Original library functions may not be deleted. */
  104. {
  105.  int place;
  106.  struct formu_item *scan;
  107.  
  108.  if((place=where_table(name)) == -1)
  109.   return -1;
  110.  if(place<STD_LIB_NUM)
  111.   return -1;
  112.  
  113.  free(ftable[place].name);
  114.  for(scan = &ftable[place]; scan->f!=NULL; scan++) {
  115.   DBG(printf("%s %s \t",scan->name,scan->f));
  116.   scan->name  =  (scan+1)->name;
  117.   scan->f     =  (scan+1) -> f;
  118.   scan->n_pars = (scan+1) -> n_pars;
  119.  }
  120.  return scan-ftable;
  121. } /*end of fdel */
  122.  
  123. int fnew(CHAR *name, void *f, int n_pars)
  124. {
  125.  struct formu_item *where;
  126.  
  127.  if(n_pars<0 || n_pars>3)
  128.   return 0;
  129.  
  130.  for(where=ftable; where->f != NULL && strcmp(name,where->name); where++);
  131.  if(where->f != NULL) {
  132.   where->f=f;
  133.   where->n_pars = n_pars;   /*old function is superseded */
  134.   return 1;
  135.  } else if((where-ftable) >= TABLESIZE-1)
  136.   return 0;  /*table is full */
  137.  else {
  138.   where->name = (char *) calloc(strlen(name)+1, sizeof(CHAR));
  139.   if(where->name==NULL) return 0;  /* no memory */
  140.   strcpy(where->name,name);
  141.   where->f=f;
  142.   where->n_pars = n_pars;
  143.   return 1;
  144.  }
  145. }  /* end of fnew */
  146.  
  147.  
  148. double f_x_val(UCHAR *function, double x)
  149. {
  150.  param['x'-'a']=x;
  151.  return value(function);
  152. }
  153.  
  154. double fval(UCHAR *function, CHAR *args, ...)
  155. {
  156.  va_list ap;
  157.  double result;
  158.  
  159.  DBG(puts("Enter fval"));
  160.  va_start(ap, args);
  161.  while(*args)
  162.   param[(*args++)-'a'] = va_arg(ap, double);
  163.  va_end(ap);
  164.  result=value(function);
  165.  return result;
  166. }
  167.  
  168. #define BUFSIZE 500
  169.  
  170. double value(register UCHAR *function)
  171. {
  172.  double buffer[BUFSIZE];
  173.  register double *bufp = buffer;
  174.       /* points to the first free space in the buffer */
  175.  double x,y,z;
  176.  register double result;
  177.  
  178.  if(!function) return 0; /* non-existent function; result of
  179.                 an unsuccesful call to translate */
  180.  for(;;) {
  181.    switch(*function++) {
  182.     case '\0':goto finish; /* this function must be as fast as possible */
  183.     case 'D': *bufp++ = *((double *) function)++;
  184.           DBG(printf("%g ",*(bufp-1)));
  185.           break;
  186.     case 'V': *bufp++ = param[(*function++)-'a'];
  187.           DBG( printf("%c = %g  ",*(function-1),*(bufp-1)) );
  188.           break;
  189.     case 'M':DBG(printf("Unary - "));
  190.          result = -(*--bufp);
  191.          *bufp++ = result;
  192.          break;
  193.     case '+':DBG(printf("+ "));
  194.          y = *(--bufp);
  195.          result = y + *(--bufp);
  196.          *bufp++ = result;
  197.       break;
  198.     case '-':DBG(printf("- "));
  199.          y = *--bufp;
  200.          result= *(--bufp) - y;
  201.          *bufp++ = result;
  202.          break;
  203.     case '*':DBG(printf("* "));
  204.          y = *(--bufp);
  205.          result = *(--bufp) * y;
  206.          *bufp++ = result;
  207.          break;
  208.     case '/':DBG(printf("/ "));
  209.          y = *--bufp;
  210.          result = *(--bufp) / y;
  211.          *bufp++ = result;
  212.          break;
  213.     case '^':DBG(printf("^ "));
  214.          y = *--bufp;
  215.          result = pow(*(--bufp),y);
  216.          *bufp++ = result;
  217.          break;
  218.     case 'F':DBG(printf("%s ",ftable[*function].name));
  219.          switch(ftable[*function].n_pars) {
  220.            case 0:*bufp++ = (*((double (*)(void))
  221.                       ftable[*function++].f))();
  222.               break;
  223.            case 1:x = *--bufp;
  224.               *bufp++ = (*((double (*)(double))
  225.                       ftable[*function++].f))(x);
  226.               break;
  227.         case 2:y = *--bufp;
  228.            x = *--bufp;
  229.            *bufp++ = (*((double (*)(double,double))
  230.                       ftable[*function++].f))(x,y);
  231.               break;
  232.            case 3:z = *--bufp;
  233.               y = *--bufp;
  234.               x = *--bufp;
  235.               *bufp++ = (*((double (*)(double, double, double))
  236.                      ftable[*function++].f))(x,y,z);
  237.               break;
  238.            default:printf("Bug! too many parameters\n");
  239.                return 0;
  240.          break;
  241.           }
  242.          break;
  243.     default:puts("Bug! Unrecognizable operator");
  244.      return 0;
  245.      break;
  246.    }
  247.  }
  248.  finish: if((bufp-buffer)!=1)
  249.       {
  250.        putchar('\n');
  251.        puts("Bug! Too many things in the buffer");
  252.        printf("Buffer: ");
  253.        while(bufp-- > buffer)
  254.         printf("%g ",*bufp);
  255.        putchar('\n');
  256.       }
  257.      else DBG(putchar('\n'));
  258.      return buffer[0];
  259. } /* end of value */
  260.  
  261.  
  262.  
  263. static int isoper(CHAR c)
  264. {
  265.  return ((c == '+') || (c == '-') || (c == '*') || (c == '/')
  266.             || (c == '^'));
  267. }
  268.  
  269. static int is_code_oper(UCHAR c)
  270. {
  271.  return ((c == '+') || (c == '-') || (c == '*') || (c == '/')
  272.             || (c == '^') || (c == 'M'));
  273. }
  274. static int isin_real(CHAR c)
  275. /* + and - are not included */
  276. {
  277.  return (isdigit(c) || c=='.' || c=='E');
  278. }
  279.  
  280. size_t max_size(CHAR *source)
  281. /* gives an upper estimate of the size required for
  282.    the coded form of source (including the final '\0') */
  283. /* Take care when modifying: the upper estimate
  284.    returned by max_size must not also accomodate
  285.    *proper* output, but also *improper* output
  286.    which takes place before the translator detects an error. */
  287. {
  288.  int numbers=0;
  289.  int functions=0;
  290.  int operators=0;
  291.  int variables=0;
  292.  
  293.  const size_t func_size=2*sizeof(UCHAR);
  294.  const size_t var_size=2*sizeof(UCHAR);
  295.  const size_t num_size=sizeof(UCHAR)+sizeof(double);
  296.  const size_t op_size=sizeof(UCHAR);
  297.  const size_t end_size=sizeof('\0');
  298.  
  299.  CHAR *scan;
  300.  
  301.  for(scan=source; *scan; scan++)
  302.   if(isalpha(*scan) && (*scan != 'E'))
  303.   {
  304.    if(isalpha(*(scan+1))) ; /* it is a function name,
  305.                 it will be counted later on */
  306.    else if(*(scan+1) == '(')  functions++;
  307.    else variables++;
  308.   }
  309.  
  310.  if(isoper(*source)) operators++;
  311.  if(*source != '\0')
  312.   for(scan = source+1; *scan; scan++)
  313.    if(isoper(*scan) && *(scan-1) != 'E') operators++;
  314.  
  315.  /* counting numbers.. */
  316.  scan=source;
  317.  while(*scan)
  318.   if(isin_real(*scan) || ((*scan == '+' || *scan == '-') &&
  319.                scan>source && *(scan-1)=='E'))
  320.    {numbers++;
  321.     scan++;
  322.     while(isin_real(*scan) || ((*scan == '+' || *scan == '-') &&
  323.                 scan>source && *(scan-1)=='E'))
  324.      scan++;
  325.    }
  326.   else scan++;
  327.  
  328.  return(numbers*num_size + operators*op_size + functions*num_size
  329.              + variables*var_size + end_size);
  330.  /*Do you wonder why "functions" is multiplied with "num_size"
  331.    and not with func_size? This function calculates an upper-bound
  332.    (i.e. pessimistic) estimate. It supposes that all functions are
  333.    converted into doubles by comp_time. For example, pi() actually
  334.    becomes a double. */
  335. }
  336.  
  337. UCHAR *translate(CHAR *source, CHAR *args, int *leng, int *error)
  338. /* source and args are not modified, but the keyword "const"
  339.    is ommitted to avoid complaints of hypersensitive compilers */
  340. {
  341.  UCHAR *result;
  342.  CHAR *scan, *scarg;
  343.  UCHAR *function;
  344.  UCHAR *nfunc; /* used to free unused heap space */
  345.  size_t size_estim; /* upper bound for the size of the
  346.                     coded function */
  347.  
  348.  i_error=NULL;
  349.  
  350.  
  351.  /* search for undeclared parameters */
  352.  for(scan=source; *scan != '\0'; scan++) {
  353.   if(islower(*scan) && !isalpha(*(scan+1)) &&
  354.       (scan==source || !isalpha(*(scan-1))) ) {
  355.    for(scarg=args; *scarg != '\0' && *scarg != *scan; scarg++)
  356.      ;
  357.    if(*scarg == '\0') /*parameter not found */
  358.     {
  359.      i_error = scan;
  360.  
  361.      *leng = 0;
  362.      *error = i_error - source;
  363.      return NULL;
  364.     }
  365.   }
  366.  }  /* end of search for undeclared... */
  367.  
  368.  size_estim=max_size(source); /* upper estimate of the size
  369.                  of the coded function,
  370.                  which doesn't exist yet */
  371.  
  372.  if(!(function = (UCHAR *) malloc(size_estim))) {
  373.   /* out of memory */
  374.   *leng = 0;
  375.   *error = -1;
  376.   return NULL;
  377.  }
  378.  
  379.  result=i_trans(function,source,source+strlen(source));
  380.  if(!result) {
  381.   free(function);
  382.   *leng = 0;
  383.   if(i_error)
  384.    *error = i_error-source;
  385.   else *error = -1; /* out of memory */
  386.   return NULL;
  387.  }
  388.  else { /* OK */
  389.   *result = '\0';
  390.   *error = -1;
  391.   *leng = result-function;
  392.  
  393.   /* free unused heap space.. */
  394.   if(((*leng)+1) * sizeof(UCHAR) > size_estim)
  395.    /* one must use (*leng)+1 instead of *leng because '\0'
  396.       has not been counted */
  397.    {
  398.     printf("Dangerous bug! The size estimate falls short by %d bytes",
  399.        ((*leng)+1) * sizeof(UCHAR) - size_estim);
  400.     puts("    Please, tell the author about this error immediately! ");
  401.     puts("Don't forget to write down what mathematical function caused");
  402.     puts("the program to crash. This program's reliability depends on you!");
  403.     puts("Press c and ENTER to continue");
  404.     getchar();
  405.    }
  406.   else if(((*leng)+1) * sizeof(UCHAR) < size_estim) {
  407.    if(nfunc = (UCHAR *) malloc(((*leng)+1) * sizeof(UCHAR))) {
  408.     memcpy( nfunc, function, ((*leng)+1) * sizeof(UCHAR) );
  409.     free(function);
  410.     function=nfunc;
  411.    }
  412.    /* free unused space */
  413.   return function;
  414.   } /* end of if-else stairs */
  415.  } /* end of OK */
  416. }  /* end of translate */
  417.  
  418. static UCHAR *comp_time(UCHAR *function, UCHAR *fend, int npars)
  419.   /* calculates at "compile time" */
  420.   /* Postconditions: If the coded expression in *function..*(fend-1)
  421.       can be calculated, its value is stored in *function..*(fend-1) */
  422.   /* comp_time returns a pointer to the first character after the
  423.      end of the coded function; if this function cannot be evaluated
  424.      at compile time, comp_time returns fend, of course.  */
  425.   /* Only memory positions from *function to *comp_time are touched. */
  426. {
  427.   UCHAR *scan;
  428.   int ok;
  429.   UCHAR temp;
  430.   double tempd;
  431.  
  432.  
  433.   ok=1;
  434.   scan=function;
  435.   while(npars-- > 0) {
  436.    if(*scan++ != 'D') ok=0;
  437.    ((double *)scan)++;
  438.   }
  439.  
  440.   if(!ok ||
  441.       !( ( scan == fend - (sizeof((UCHAR) 'F')+sizeof(UCHAR))
  442.        && *(fend-2) == 'F' ) ||
  443.      ( scan == fend - sizeof(UCHAR)
  444.        && is_code_oper(*(fend-1)) ) )
  445.     )
  446.     /* compile-time evaluation is done only
  447.        if everything but the ending function consists of doubles */
  448.    return fend;
  449.  
  450.   temp = *fend;
  451.   *fend = '\0';
  452.  
  453.   tempd = value(function);
  454.   *fend = temp;
  455.   *function++ = 'D';
  456.   *((double *)function)++ = tempd;
  457.  
  458.   return function;
  459. } /* end of comp_time */
  460.  
  461. static CHAR *my_strtok(CHAR *s)
  462. /* a version of strtok that respects parentheses */
  463. /* token delimiter = comma */
  464. {
  465.  int pars;
  466.  static CHAR *token=NULL;
  467.  CHAR *next_token;
  468.  
  469.  if(s!=NULL) token=s;
  470.  else if(token!=NULL) s=token;
  471.  else return NULL;
  472.  
  473.  for(pars=0; *s != '\0' && (*s != ',' || pars!=0); s++) {
  474.    if(*s == '(') ++pars;
  475.    if(*s == ')') --pars;
  476.  }
  477.  if(*s=='\0') {
  478.   next_token=NULL;
  479.   s=token;
  480.  
  481.   token=next_token;
  482.   DBG(printf("The token is: %s\n",s));
  483.   return s;
  484.  } else {
  485.   *s = '\0';
  486.   next_token=s+1;
  487.   s=token;
  488.  
  489.   token=next_token;
  490.   DBG(printf("The token is: %s\n",s));
  491.   return s;
  492.  }
  493. } /* end of my_strtok */
  494.  
  495. #define TWO_OP {                                 \
  496.   if((tempu=i_trans(function,begin,scan)) &&      \
  497.       (temp3=i_trans(tempu,scan+1,end)) ) {       \
  498.    *temp3++ = *scan; /* copies operator */                 \
  499.    temp3=comp_time(function,temp3,2);   /*tries to simplify expression*/ \
  500.    return temp3; /* expression has been translated */                    \
  501.   } else return NULL;   /* something is wrong with the operands */       \
  502.  }
  503. #define ERROR_MEM {    \
  504.    i_error=NULL;       \
  505.    return NULL;           \
  506.    /* out of memory */ \
  507.  }
  508.  
  509. static UCHAR *i_trans(UCHAR *function, CHAR *begin, CHAR *end)
  510.  /* the source is *begin .. *(end-1) */
  511.  /* returns NULL if an error occured; otherwise, returns a
  512.     pointer to the first character after the end of function[] */
  513.  /* i_trans() does not write a '\0' at the end of function[], */
  514.  /* but it MAY touch its end (i.e. *i_trans) without changing it.*/
  515. {
  516.  int pars;     /* parentheses */
  517.  CHAR *scan;
  518.  UCHAR *tempu, *temp3;
  519.  CHAR *temps;
  520.  CHAR tempch;
  521.  double tempd;
  522.  CHAR *endf;     /* points to the opening
  523.             parenthesis of a function (e.g. of sin(x) ) */
  524.  int n_function;
  525.  int space;
  526.  int i;
  527.  
  528.  CHAR *paramstr[MAXPAR];
  529.  CHAR *par_buf;
  530.  
  531.  if(begin>=end) {
  532.   i_error = begin;
  533.   return NULL;
  534.  }
  535.  
  536.  DBG(tempch = *end);
  537.  DBG(*end = '\0');
  538.  DBG(puts(begin));
  539.  DBG(*end = tempch);
  540.  
  541.  /* test paired parentheses */
  542.  for(pars=0, scan=begin; scan<end && pars>=0; scan++) {
  543.   if(*scan == '(') pars++;
  544.   else if(*scan == ')') pars--;
  545.  }
  546.  if(pars<0 || pars>0) {
  547.   i_error = scan-1;
  548.   return NULL;
  549.  }
  550.  
  551.  /* plus and binary minus */
  552.  for(pars=0, scan=end-1; scan>=begin; scan--) {
  553.   if(*scan == '(') pars++;
  554.   else if(*scan == ')') pars--;
  555.   else if(!pars && (*scan == '+' || ((*scan == '-') && scan!=begin))
  556.                       /* recognizes unary
  557.                          minuses */
  558.          && (scan==begin || *(scan-1)!='E') )
  559.       /* be wary of misunderstanding exponential notation */
  560.    break;
  561.  }
  562.  
  563.  if(scan >= begin) TWO_OP
  564.  
  565.  /* multiply and divide */
  566.  for(pars=0, scan=end-1; scan>=begin; scan--) {
  567.   if(*scan == '(') pars++;
  568.   else if(*scan == ')') pars--;
  569.   else if(!pars && (*scan == '*' || *scan == '/' ))
  570.    break;
  571.  }
  572.  
  573.  if(scan >= begin) TWO_OP
  574.  
  575.  /* power */
  576.  for(pars=0, scan=end-1; scan>=begin; scan--) {
  577.   if(*scan == '(') pars++;
  578.   else if(*scan == ')') pars--;
  579.   else if(!pars && (*scan == '^'))
  580.    break;
  581.  }
  582.  
  583.  if(scan >= begin) TWO_OP
  584.  
  585.  /* unary minus */
  586.  if(*begin == '-') {
  587.   if(tempu=i_trans(function,begin+1,end)) {
  588.    *tempu++ = 'M';
  589.    tempu=comp_time(function,tempu,1); /*tries to simplify
  590.                     expression*/
  591.    return tempu;
  592.   } else return NULL;
  593.  }
  594.  
  595.  /* erase white space */
  596.  while(isspace(*begin))
  597.   begin++;
  598.  while(isspace(*(end-1)))
  599.   end--;
  600.  
  601.  /* parentheses around the expression */
  602.  if(*begin == '(' && *(end-1) == ')')
  603.   return i_trans(function,begin+1,end-1);
  604.  
  605.  /* variable */
  606.  if(end == begin+1 && islower(*begin)) {
  607.   *function++ = 'V';
  608.   *function++ = *begin;
  609.   return function;
  610.  }
  611.  
  612.  /* number */
  613.  tempch = *end;
  614.  *end = '\0';
  615.  tempd=strtod(begin,(CHAR**) &tempu);
  616.  *end = tempch;
  617.  if((CHAR*) tempu == end) {
  618.   *function++ = 'D';
  619.   *((double *)function)++ = tempd;
  620.   return function;
  621.  }
  622.  
  623.  /*function*/
  624.  if(!isalpha(*begin) && *begin != '_')
  625.             /* underscores are allowed */
  626.  {
  627.   i_error=begin;
  628.   return NULL;
  629.  }
  630.  for(endf = begin+1; endf<end && (isalnum(*endf) || *endf=='_');
  631.                                endf++);
  632.  tempch = *endf;
  633.  *endf = '\0';
  634.  if((n_function=where_table(begin)) == -1) {
  635.   *endf = tempch;
  636.   i_error=begin;
  637.   return NULL;
  638.  }
  639.  *endf = tempch;
  640.  if(*endf != '(' || *(end-1) != ')') {
  641.   i_error=endf;
  642.   return NULL;
  643.  }
  644.  if(ftable[n_function].n_pars==0) {
  645.   /*function without parameters (e.g. pi() ) */
  646.    space=1;
  647.    for(scan=endf+1; scan<(end-1); scan++)
  648.     if(!isspace(*scan)) space=0;
  649.    if(space) {
  650.     *function++ = 'F';
  651.     *function++ = n_function;
  652.     function = comp_time(function-2,function,0);
  653.     return function;
  654.    } else {
  655.     i_error=endf+1;
  656.     return NULL;
  657.    }
  658.  } else {    /*function with parameters*/
  659.     tempch = *(end-1);
  660.     *(end-1) = '\0';
  661.     par_buf = (CHAR *) malloc(strlen(endf+1)+1);
  662.     if(!par_buf)
  663.      ERROR_MEM;
  664.     strcpy(par_buf, endf+1);
  665.     *(end-1) = tempch;
  666.     /* look at the first parameter */
  667.     for(i=0; i<ftable[n_function].n_pars; i++) {
  668.      if( ( temps=my_strtok((i==0) ? par_buf : NULL) ) == NULL )
  669.       break; /* too few parameters */
  670.      paramstr[i]=temps;
  671.     }
  672.     if(temps==NULL) {
  673.      /* too few parameters */
  674.      free(par_buf);
  675.      i_error=end-2;
  676.      return NULL;
  677.     }
  678.     if((temps=my_strtok(NULL))!=NULL) {
  679.      /* too many parameters */
  680.      free(par_buf);
  681.      i_error=(temps-par_buf)+(endf+1); /* points to the first character
  682.                       of the first superfluous
  683.                       parameter */
  684.      return NULL;
  685.     }
  686.  
  687.     tempu=function;
  688.     for(i=0; i<ftable[n_function].n_pars; i++)
  689.      if(!(tempu=i_trans( tempu, paramstr[i],
  690.                  paramstr[i]+strlen(paramstr[i]) ) ) )
  691.      {
  692.       i_error=(i_error-par_buf)+(endf+1); /* moves i_error to
  693.                        the permanent copy of the
  694.                        parameter */
  695.       free(par_buf);
  696.       return NULL; /* error in one of the parameters */
  697.      }
  698.     /* OK */
  699.     free(par_buf);
  700.     *tempu++ = 'F';
  701.     *tempu++ = n_function;
  702.     tempu = comp_time(function,tempu,ftable[n_function].n_pars);
  703.     return tempu;
  704.  }
  705. }
  706.  
  707. static double pi(void)
  708. {
  709.  return 3.14159265358979323846264;
  710. }
  711.