Sindbad~EG File Manager

/* M. Beeson, for Mathpert;
5.16.94  extracted from deval.c to permit making deval.dll
5.18.94 corrected dmodexp which had >>2 instead of 1 and
         also had n instead of x--how did it ever compile as part of deval?
         Similarly dmod had wrong types passed to fmod??!
1.22.98 MEXPORT_ALGEBRA
9.6.04  Moved back into deval.dll
9.7.04  Disabled dmodexp, making it return BADVAL.  It was formerly based on an erroneous
        idea.
1.18.06 removed unreferenced variables from dmodexp
*/

#define DEVAL_DLL
#include <math.h>
#include <assert.h>
#include <string.h>
#include "export.h"
#include "terms.h"
#include "deval.h"
#include "dcomplex.h"
#include "ceval.h"
#include "dmod.h"

/*________________________________________________________________________*/
MEXPORT_DEVAL double dmod(term t, double y)
/* compute t mod y as a double, getting the right answer if possible when
t is very large compared to y so that fmod is inaccurate.  In particular,
get the right answer in case t is a large multiple of pi and y is 2pi. */
/* dmod returns a positive value in the range 0 to y */
/* return BADVAL if can't get an answer accurate to at least three decimal
digits */

{ int i,err;
  double x,z;  /* temporary storage */
  double ans;
  unsigned f = FUNCTOR(t);
  if (ISATOM(t))
    return fmod(DOUBLEDATA(t),y);
  if (OBJECT(t))
    switch( TYPE(t))
       { case INTEGER:  return fmod((double) INTDATA(t),y);
         case DOUBLE:   return fmod(DOUBLEDATA(t),y);
         case BIGNUM:   err = bignum_double(BIGNUMDATA(t),&ans);
                        if(err)
                           return BADVAL;
                        return ans;
         default:  assert(0);  /* no other objects in MATHPERT */
       }
  switch(f)
    {  case '-' :  ans =  dmod(ARG(0,t),y);
                   return (ans == BADVAL ? ans : y - ans);
       case '*' :  x = dmod(ARG(0,t),y);
                   if(x==BADVAL)
                      return x;
                   for(i=1;i<ARITY(t);i++)
                      { z = dmod(ARG(i,t),y);
                        if(z==BADVAL)
                           return z;
                        x = fmod(x*z,y);
                      }
                   return x;
       case '+' :  x = dmod(ARG(0,t),y);
                   if(x==BADVAL)
                      return x;
                   for(i=1;i<ARITY(t);i++)
                      { z = dmod(ARG(i,t),y);
                        if(z==BADVAL)
                           return z;
                        x = fmod(x+z,y);
                      }
                   return x;
       case '^' :  if(!ISINTEGER(ARG(1,t)))
                      break;
                   /* and if the exponent IS an integer, use the
                   Russian peasant method. */
                   deval(ARG(0,t),&x);
                   if(x==BADVAL)
                      return x;
                   return dmodexp(y,fmod(x,y),INTDATA(ARG(1,t)));
    }
  deval(t,&ans);
  return (ans == BADVAL ? ans : fmod(ans,y));
}
/*__________________________________________________________________*/
MEXPORT_DEVAL double dmodexp(double m, double a, unsigned long b)
/* compute a^b mod m. */
/* Note that x^2 mod m is NOT equal to (x mod m)^2 mod m, when x mod m is not an integer,
so you can't imitate the usual modular exponentiation algorithm.
   This can't be done correctly with fixed-precision arithmetic.  You will need
many digits of m.    
*/ 

{ if(b==0)
     return 1;
  if(b==1)
     return fmod(a,m);
  return BADVAL;
}