Sindbad~EG File Manager

/* evaluate sums numerically using rational arithmetic */
/*  M. Beeson, for Mathpert
6.26.90 original date
1.19.99 last modified
*/

#include <math.h>
#include <string.h>
#define POLYVAL_DLL
#include "globals.h"
#include "dcomplex.h"
#include "mpmem.h"
#include "progress.h"
/*________________________________________________________________*/
/* evaluating indexed sums efficiently depends on not having to
actually substitute different values for the index variable.  This is
achieved by letting arith calculate values for atoms when certain
global variables say to do so.  Namely, if global variable
doing_indexedsum  is nonzero, then it is assumed to be the
functor value of the index variable, and arith will look for a
long integer under the global variable sumvar. */


/* The heap is managed so that all scratch space used by this function
is released every eight terms, and again at the end, so that NO net
heap space is used except what is required to store the answer!  */

/* Return value 0 is success, 1 is out-of-space, 62 is user-abort;
   all non-zero errors are keyed to messages by aem(error-number)
*/

#define NTERMS 50  /* report on progress if there are more than NTERMS terms */

MEXPORT_POLYVAL int eval_indexedsum(term sum, term *ans,aflag flag)
/* Evaluate the indexed sum 'sum', producing the result in fresh space.  */
{ long lo,hi,k;
  int err;
  term temp;
  unsigned long lo1, hi1;
  void  *startnode;  /* last node on heap at entrance to this function */
  int save_doingindexedsum;
  term upper,lower,index, arg;
  term partialsum,numarg,next;
  arg = ARG(0,sum);
  index = ARG(1,sum);
  lower = ARG(2,sum);
  upper = ARG(3,sum);
  /* check that lower and upper limits are integers < 32 k */
  if(!INTEGERP( NEGATIVE(lower) ? ARG(0,lower) : lower))
     return 9;
  if(!INTEGERP( NEGATIVE(upper) ? ARG(0,upper) : upper))
     return 10;
  /* Now the upper and lower limits are positive or negative integers or
     bignums.  We also reject bignums here. */
  if(!ISINTEGER( NEGATIVE(lower) ? ARG(0,lower) : lower))
     return 11;
  if(!ISINTEGER( NEGATIVE(upper) ? ARG(0,upper) : upper))
     return 12;
  lo1 = NEGATIVE(lower) ? INTDATA(ARG(0,lower)) : INTDATA(lower);
  hi1 = NEGATIVE(upper) ? INTDATA(ARG(0,upper)) : INTDATA(upper);
  if(lo1 & 0x8000 )
     return FUNCTOR(sum)== SUM ? 11 : 14;
  if(hi1 & 0x8000 )
     return FUNCTOR(sum)== SUM ? 12 : 15;
  lo = NEGATIVE(lower) ? - (long) lo1 : (long) lo1;
  hi = NEGATIVE(upper) ? - (long) hi1 : (long) hi1;
  sumvar = lo;
  if(lo > hi)   /* by convention an empty sum is zero.  This is important
                   in evaluating functions defined by recurrence relation as
                   it allows avoiding a definition by cases. */
     { *ans = zero;
       return 0;
     }
  save_doingindexedsum = doing_indexedsum;
  /* this allows it to evaluate nested sums */
  doing_indexedsum = FUNCTOR(index);
  CHANGE_VALUE(index,lo);
  startnode = heapmax();  /* see memory.c */
  err = arith(arg,&partialsum,flag);  /* puts partialsum in new space */
  if (err)
     { doing_indexedsum = save_doingindexedsum;
       if(err == 2)
          copy(sum,ans);  /* this can happen if arg contains a defined function with 
                          numerical argument */
       return err;
     }
  if(lo==hi || !AE(partialsum))
     { *ans = partialsum;
       doing_indexedsum = save_doingindexedsum;
       return (AE(partialsum) ? 0 : 2);
     }
  for(k=lo + 1; k<= hi; k++)
     { sumvar = k;
       CHANGE_VALUE(index,k);
       arith(arg,&numarg,flag);
       if(!AE(numarg))
          { doing_indexedsum=0;
            return FUNCTOR(sum) == SUM ? 13 : 16;
          }
       err = cadd(partialsum,numarg,&next);  /* so can do complex sums */
               /* if the index variable is 'i' it will be correctly interpreted
                  because 'arith' will hit the indexsum clause first before the
                  clause for evaluating 'i' as sqrt(-1) */
       if(err)
          { reset_heap(startnode);  /* free all space used so far */
            return err;
          }
       if((k & 0x0007) == 0)  /* do it every 8-th value of k */
          save_and_reset(next,startnode,&partialsum);
       else
          partialsum = next;
       if(hi-lo > NTERMS)  /* display progress after first NTERMS terms */
          { temp = make_int(k-lo);
            err = display_progress(temp, 802); /* Number of terms evaluated: */
            if(HASARGS(temp))
               RELEASE(temp);
            if(err)
               /* Nonzero return from display_progress means the user cancelled the computation */
                 break;   /* out of the for-loop */
          }
     }
  if(hi-lo > NTERMS)
     end_display_progress();
  save_and_reset(partialsum,startnode,ans);
  doing_indexedsum = save_doingindexedsum;     
  /* reset to previous value so arith won't evaluate the index variable */
  /* Unless doing a nested sum, the old value will be zero. */
  return (k==hi+1) ? 0 : 62;  /* if k <= hi it means user pressed Esc to abort */
}
#undef NTERMS