/*
 * File: oarith.c
 *  Contents: divide, minus, mod, mult, neg, number, plus, powr
 */

#include <math.h>
#include "..\h\config.h"
#include "..\h\rt.h"
#include "rproto.h"


#ifdef SUN
#include <signal.h>
#endif					/* SUN */

int over_flow;

/*
 * x / y - divide y into x.
 */

OpDcl(divide,2,"/")
   {
   register int t1, t2;
   double r1, r2;

   /*
    * Arg1 and Arg2 must be numeric.
    */
   if ((t1 = cvnum(&Arg1)) == CvtFail)
      RunErr(102, &Arg1);
   if ((t2 = cvnum(&Arg2)) == CvtFail) 
      RunErr(102, &Arg2);

   if (t1 == T_Integer && t2 == T_Integer) {
      /*
       * Arg1 and Arg2 are both integers, just divide them and return the
       * result.
       */
      if (IntVal(Arg2) == 0L) 
         RunErr(201, &Arg2);

#if MSDOS && LATTICE
      {
      long i, j;
      i = IntVal(Arg1);
      j = i / IntVal(Arg2);
      MakeInt(j, &Arg0);
      }
#else					/* MSDOS && LATTICE */
       MakeInt(IntVal(Arg1) / IntVal(Arg2), &Arg0);
#endif					/* MSDOS && LATTICE */

      }
   else if (t1 == T_Real || t2 == T_Real) {
      /*
       * Either Arg1 or Arg2 or both is real, convert the real values to
       *  integers, divide them, and return the result.
       */
      if (t1 != T_Real) {

#ifdef LargeInts
         if (t1 == T_Bignum)
	    r1 = bigtoreal(&Arg1);
	 else
#endif					/* LargeInts */

            r1 = IntVal(Arg1);
         }
      else
	 r1 = BlkLoc(Arg1)->realblk.realval;

      if (t2 != T_Real) {

#ifdef LargeInts
	 if (t2 == T_Bignum)
	    r2 = bigtoreal(&Arg2);
	 else
#endif					/* LargeInts */

            r2 = IntVal(Arg2);
         }
      else
	 r2 = BlkLoc(Arg2)->realblk.realval;

      if (r2 == 0.0) 
         RunErr(-204, NULL);

      if (makereal(r1 / r2, &Arg0) == Error) 
         RunErr(0, NULL);

#ifdef SUN
      if (((struct b_real *)BlkLoc(Arg0))->realval == HUGE)
         kill(getpid(),SIGFPE);
#endif					/* SUN */

      }

#ifdef LargeInts
   else {
      /*
       * Neither Arg1 or Arg2 are real and at least one is a large int.
       */
      if (bigdiv(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	 RunErr(0, NULL);
      }
#endif					/* LargeInts */

   Return;
   }


/*
 * x - y - subtract y from x.
 */

OpDcl(minus,2,"-")
   {
   register int t1, t2;
   double r1, r2;

   /*
    * x and y must be numeric.  Save the cvnum return values for later use.
    */
   if ((t1 = cvnum(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   if ((t2 = cvnum(&Arg2)) == CvtFail) 
      RunErr(102, &Arg2);

   if (t1 == T_Integer && t2 == T_Integer) {
      /*
       * Both x and y are integers.  Perform integer subtraction and place
       *  the result in Arg0 as the return value.
       */

      MakeInt(sub(IntVal(Arg1), IntVal(Arg2)), &Arg0);
      if (over_flow)

#ifdef LargeInts
	 if (bigsub(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	    RunErr(0, NULL);
#else					/* LargeInts */
         RunErr(-203, NULL);
#endif					/* LargeInts */

      }
   else if (t1 == T_Real || t2 == T_Real) {
      /*
       * Either x or y is real, convert the other to a real, perform
       *  the subtraction and place the result in Arg0 as the return value.
       */
      if (t1 != T_Real) {

#ifdef LargeInts
         if (t1 == T_Bignum)
	    r1 = bigtoreal(&Arg1);
	 else
#endif					/* LargeInts */

            r1 = IntVal(Arg1);
         }
      else
	 r1 = BlkLoc(Arg1)->realblk.realval;

      if (t2 != T_Real) {

#ifdef LargeInts
	 if (t2 == T_Bignum)
	    r2 = bigtoreal(&Arg2);
	 else
#endif					/* LargeInts */

            r2 = IntVal(Arg2);
         }
      else
	 r2 = BlkLoc(Arg2)->realblk.realval;

#ifdef  RTACIS
      {
      double rtbug_temporary;	/* bug with "-" arithmetic as parameter */
      rtbug_temporary = r1 - r2;	
      if (makereal(rtbug_temporary, &Arg0) == Error) 
         RunErr(0, NULL);
#else					/* RTACIS */
      if (makereal(r1 - r2, &Arg0) == Error) 
         RunErr(0, NULL);
#endif					/* RTACIS */

      }

#ifdef LargeInts
   else {
      /*
       * Neither Arg1 or Arg2 are real and at least one is a large int.
       */
      if (bigsub(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	 RunErr(0, NULL);
      }
#endif					/* LargeInts */

   Return;
   }


/*
 * x % y - take remainder of x / y.
 */

OpDcl(mod,2,"%")
   {
   register int t1, t2;
   long int_rslt;
   double r1, r2, real_rslt;

   /*
    * x and y must be numeric.  Save the cvnum return values for later use.
    */
   if ((t1 = cvnum(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   if ((t2 = cvnum(&Arg2)) == CvtFail) 
      RunErr(102, &Arg2);

   if (t1 == T_Integer && t2 == T_Integer) {
      /*
       * Both x and y are integers.  If y is 0, generate an error because
       *  it's divide by 0.  Otherwise, just return the modulus of the
       *  two arguments.
       */
      if (IntVal(Arg2) == 0L) 
         RunErr(202, &Arg2);

#if MSDOS && LATTICE
      {
      long i;
      i = IntVal(Arg1);
      int_rslt = i % IntVal(Arg2);
      }
#else					/* MSDOS && LATTICE */
       int_rslt = IntVal(Arg1) % IntVal(Arg2);
#endif					/* MSDOS && LATTICE */

      /*
       * The sign of the result must match that of n1.
       */
      if (IntVal(Arg1) < 0) {
         if (int_rslt > 0)
            int_rslt -= Abs(IntVal(Arg2));
         }
      else if (int_rslt < 0)
         int_rslt += Abs(IntVal(Arg2));
      MakeInt(int_rslt, &Arg0);
      }
   else if (t1 == T_Real || t2 == T_Real) {
      /*
       * Either x or y is real, convert the other to a real, get
       *  the modulus, convert the result to an integer and place it
       *  in Arg0 as the return value.
       */
      if (t1 != T_Real) {

#ifdef LargeInts
	 if (t1 == T_Bignum)
	    r1 = bigtoreal(&Arg1);
	 else
#endif					/* LargeInts */

            r1 = IntVal(Arg1);
         }
      else
	 r1 = BlkLoc(Arg1)->realblk.realval;

      if (t2 != T_Real) {

#ifdef LargeInts
	 if (t2 == T_Bignum)
	    r2 = bigtoreal(&Arg2);
	 else
#endif					/* LargeInts */

            r2 = IntVal(Arg2);
         }
      else
	 r2 = BlkLoc(Arg2)->realblk.realval;

      real_rslt = r1 - r2 * (int)(r1 / r2);
      /*
       * The sign of the result must match that of n1.
       */
      if (r1 < 0.0) {
         if (real_rslt > 0.0)
            real_rslt -= fabs(r2);
         }
      else if (real_rslt < 0.0)
         real_rslt += fabs(r2);
      if (makereal(real_rslt, &Arg0) == Error) 
         RunErr(0, NULL);
      }

#ifdef LargeInts
   else {
      /*
       * Neither Arg1 or Arg2 are real and at least one is a large int.
       */
      if (bigmod(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	 RunErr(0, NULL);
      }
#endif					/* LargeInts */

   Return;
   }


/*
 * x * y - multiply x and y.
 */

OpDcl(mult,2,"*")
   {
   register int t1, t2;
   double r1, r2;

   /*
    * Arg1 and Arg2 must be numeric.  Save the cvnum return values for later
    *  use.
    */
   if ((t1 = cvnum(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   if ((t2 = cvnum(&Arg2)) == CvtFail) 
      RunErr(102, &Arg2);

   if (t1 == T_Integer && t2 == T_Integer) {
      /*
       * Both Arg1 and Arg2 are integers.  Perform the multiplication and
       *  and place the result in Arg0 as the return value.
       */

      MakeInt(mul(IntVal(Arg1), IntVal(Arg2)), &Arg0);
      if (over_flow)
#ifdef LargeInts
	 if (bigmul(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	    RunErr(0, NULL);
#else					/* LargeInts */
         RunErr(-203, NULL);
#endif					/* LargeInts */
      }
   else if (t1 == T_Real || t2 == T_Real) {
      /*
       * Either Arg1 or Arg2 is real, convert the other to a real, perform
       *  the subtraction and place the result in Arg0 as the return value.
       */
      if (t1 != T_Real) {

#ifdef LargeInts
	 if (t1 == T_Bignum)
	    r1 = bigtoreal(&Arg1);
	 else
#endif					/* LargeInts */

            r1 = IntVal(Arg1);
         }
      else
	 r1 = BlkLoc(Arg1)->realblk.realval;

      if (t2 != T_Real) {

#ifdef LargeInts
	 if (t2 == T_Bignum)
	    r2  = bigtoreal(&Arg2);
	 else
#endif					/* LargeInts */

            r2 = IntVal(Arg2);
         }
      else
	 r2 = BlkLoc(Arg2)->realblk.realval;

      if (makereal(r1 * r2, &Arg0) == Error) 
         RunErr(0, NULL);
      }

#ifdef LargeInts
   else {
      /*
       * Neither Arg1 or Arg2 are real and at least one is a large int.
       */
      if (bigmul(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	 RunErr(0, NULL);
      }
#endif					/* LargeInts */

   Return;
   }

/*
 * -x - negate x.
 */

OpDcl(neg,1,"-")
   {

   /*
    * Arg1 must be numeric.
    */
   switch (cvnum(&Arg1)) {

      case T_Integer:
         /*
          * If Arg1 is an integer, check for overflow by negating it and
          *  seeing if the negation didn't "work".  Use MakeInt to
          *  construct the return value.
          */

	 MakeInt(neg(IntVal(Arg1)), &Arg0);
         if (over_flow)

#ifdef LargeInts
	    if (bigneg(&Arg1, &Arg0) == Error)  /* alcbignum failed */
	       RunErr(0, NULL);
#else					/* LargeInts */
         RunErr(-203, &Arg1);
#endif					/* LargeInts */

         break;

#ifdef LargeInts
      case T_Bignum:
	 if (cpbignum(&Arg1, &Arg0) == Error)  /* alcbignum failed */
	    RunErr(0, NULL);
	 BlkLoc(Arg0)->bignumblk.sign ^= 1;
	 break;
#endif					/* LargeInts */

      case T_Real:
         /*
          * Arg1 is real, just negate it and use makereal to construct the
          *  return value.
          */

#ifdef RTACIS
         { 
         double rtbug_temporary;		/* bug with "-" as parameter */
         rtbug_temporary = -BlkLoc(Arg1)->realblk.realval;
         if (makereal(rtbug_temporary, &Arg0) == Error) 
            RunErr(0, NULL);
         }
#else					/* RTACIS */
         if (makereal(-BlkLoc(Arg1)->realblk.realval, &Arg0) == Error) 
            RunErr(0, NULL);
#endif					/* RTACIS */

         break;

      default:
         /*
          * Arg1 is not numeric.
          */
         RunErr(102, &Arg1);
      }
   Return;
   }

/*
 * +x - convert x to numeric type.
 *  Operational definition: generate runerr if x is not numeric.
 */

OpDcl(number,1,"+")
   {

   switch (cvnum(&Arg1)) {

      case T_Integer:

#ifdef LargeInts
      case T_Bignum:
#endif					/* LargeInts */

      case T_Real:
	 Arg0 = Arg1;
         break;

      default:
         RunErr(102, &Arg1);
      }
   Return;
   }

/*
 * x + y - add x and y.
 */

OpDcl(plus,2,"+")
   {
   register int t1, t2;
   double r1, r2;

   /*
    * Arg1 and Arg2 must be numeric.  Save the cvnum return values for later
    *  use.
    */
   if ((t1 = cvnum(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   if ((t2 = cvnum(&Arg2)) == CvtFail) 
      RunErr(102, &Arg2);

   if (t1 == T_Integer && t2 == T_Integer) {
      /*
       * Both Arg1 and Arg2 are integers.  Perform integer addition and plcae
       *  the result in Arg0 as the return value.
       */

      MakeInt(add(IntVal(Arg1), IntVal(Arg2)), &Arg0);
      if (over_flow)

#ifdef LargeInts
	 if (bigadd(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	    RunErr(0, NULL);
#else					/* LargeInts */
         RunErr(-203, NULL);
#endif					/* LargeInts */

      }
   else if (t1 == T_Real || t2 == T_Real) {
      /*
       * Either Arg1 or Arg2 is real, convert the other to a real, perform
       *  the addition and place the result in Arg0 as the return value.
       */
      if (t1 != T_Real) {

#ifdef LargeInts
	 if (t1 == T_Bignum)
	    r1 = bigtoreal(&Arg1);
	 else
#endif					/* LargeInts */

            r1 = IntVal(Arg1);
         }
      else
	 r1 = BlkLoc(Arg1)->realblk.realval;

      if (t2 != T_Real) {

#ifdef LargeInts
	 if (t2 == T_Bignum)
	    r2 = bigtoreal(&Arg2);
	 else
#endif					/* LargeInts */

            r2 = IntVal(Arg2);
         }
      else
	 r2 = BlkLoc(Arg2)->realblk.realval;

      if (makereal(r1 + r2, &Arg0) == Error) 
         RunErr(0, NULL);
      }

#ifdef LargeInts
   else {
      /*
       * Neither Arg1 or Arg2 are real and at least one is a large int.
       */
      if (bigadd(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	 RunErr(0, NULL);
      }
#endif					/* LargeInts */

   Return;
   }

/*
 * x ^ y - raise x to the y power.
 */

#if AMIGA
#if AZTEC_C
#ifndef RTACIS
#define RTACIS
#define AZTECHACK
#endif					/* RTACIS */
#endif					/* AZTEC_C */
#endif					/* AMIGA */

OpDcl(powr,2,"^")
   {
   register int t1, t2;
   double r1, r2;

   /*
    * Arg1 and Arg2 must be numeric.  Save the cvnum return values for later
    *  use.
    */
   if ((t1 = cvnum(&Arg1)) == CvtFail) 
      RunErr(102, &Arg1);
   if ((t2 = cvnum(&Arg2)) == CvtFail) 
      RunErr(102, &Arg2);

   if (t1 == T_Integer && t2 == T_Integer) {
      /*
       * Both Arg1 and Arg2 are integers.  Perform integer exponentiation
       *  and place the result in Arg0 as the return value.
       */

#ifdef LargeInts
      if (bigpow(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	 RunErr(0, NULL);
#else					/* LargeInts */
      MakeInt(ipow(IntVal(Arg1), IntVal(Arg2)), &Arg0);
      if (over_flow)
         RunErr(-203, NULL);
#endif					/* LargeInts */

      }
   else if (t1 == T_Real || t2 == T_Real) {
      /*
       * Either x or y is real, convert the other to a real, perform
       *  real exponentiation and place the result in Arg0 as the
       *  return value.
       */
      if (t1 != T_Real) {

#ifdef LargeInts
	 if (t1 == T_Bignum)
	    r1 = bigtoreal(&Arg1);
	 else
#endif					/* LargeInts */

            r1 = IntVal(Arg1);
         }
      else
	 r1 = BlkLoc(Arg1)->realblk.realval;

      if (t2 != T_Real) {

#ifdef LargeInts
	 if (t2 == T_Bignum)
	    r2 = bigtoreal(&Arg2);
	 else
#endif					/* LargeInts */

            r2 = IntVal(Arg2);
         }
      else
	 r2 = BlkLoc(Arg2)->realblk.realval;

      if (r1 == 0.0 && r2 <= 0.0) 
         /*
          * Tried to raise zero to a negative power.
          */
         RunErr(-204, NULL);
      if (r1 < 0.0 && t2 == T_Real) 
         /*
          * Tried to raise a negative number to a real power.
          */
         RunErr(-206, NULL);

#undef POWBUG
#ifdef RTACIS
#define POWBUG
#endif					/* RTACIS */
#ifndef POWBUG
#ifdef CRAY
#define POWBUG
#endif					/* CRAY */
#endif					/* POSBUG */

#ifdef POWBUG
      {
       double rtbug_temporary;		/* bug in pow routine for negative x */

       if ((r1 < 0.0) && /* integral? */ (((double)((long int)r2)) == r2)) {
          rtbug_temporary = -r1; 

          /*
           * The following is correct only if the exponent is odd.
           *  If the exponent is even, it should be
           *
           *      pow(-rtbug_temporary,r2);
           *
           */
          rtbug_temporary = -pow(rtbug_temporary, r2); 
          } 
       else
	  rtbug_temporary = pow(r1, r2);
       if (makereal(rtbug_temporary, &Arg0) == Error) 
          RunErr(0, NULL);
      }
#else					/* POWBUG */
      if (makereal(pow(r1, r2), &Arg0) == Error) 
         RunErr(0, NULL);
#endif					/* POWBUG */

      }

#ifdef LargeInts
   else {
      /*
       * Neither Arg1 or Arg2 are real and at least one is a large int.
       */
      if (bigpow(&Arg1, &Arg2, &Arg0) == Error)  /* alcbignum failed */
	 RunErr(0, NULL);
      }
#endif					/* LargeInts */

   Return;
   }

#if AMIGA
#if AZTEC_C
#ifdef AZTECHACK
#undef RTACIS
#endif					/* AZTECHACK */
#endif					/* AZTEC_C */
#endif					/* AMIGA */

#ifndef LargeInts
long ipow(n1, n2)
long n1, n2;
   {
   long result;

   if (n1 == 0 && n2 <= 0) {
      over_flow = 1;
      return 0;
      }
   if (n2 < 0)
      return 0;
   result = 1L;
   while (n2 > 0) {
      if (n2 & 01L)
         result *= n1;
      n1 *= n1;
      n2 >>= 1;
      }
   over_flow = 0;
   return result;
   }
#endif					/* LargeInts */