/*
 * File: rcomp.c
 *  Contents: anycmp, equiv, lexcmp, numcmp
 */

#include "..\h\config.h"
#include "..\h\rt.h"
#include "rproto.h"

/*
 * anycmp - compare any two objects.
 */

int anycmp(dp1,dp2)
dptr dp1, dp2;
   {
   register int o1, o2;
   register long lresult;
   double rres1, rres2, rresult;

   /*
    * Get a collating number for dp1 and dp2.
    */
   o1 = order(dp1);
   o2 = order(dp2);

   /*
    * If dp1 and dp2 aren't of the same type, compare their collating numbers.
    */
   if (o1 != o2)
      return (o1 > o2 ? Greater : Less);

   if (o1 == 3)
      /*
       * dp1 and dp2 are strings, use lexcmp to compare them.
       */
      return lexcmp(dp1,dp2);

   switch (Type(*dp1)) {
      case T_Integer:
	 lresult = IntVal(*dp1) - IntVal(*dp2);
	 if (lresult == 0)
	    return Equal;
	 return ((lresult > 0) ? Greater : Less);

#ifdef LargeInts
      case T_Bignum:
	 lresult = bigcmp(dp1, dp2);
	 if (lresult == 0)
	    return Equal;
	 return ((lresult > 0) ? Greater : Less);
#endif					/* LargeInts */

      case T_Real:
         GetReal(dp1,rres1);
         GetReal(dp2,rres2);
         rresult = rres1 - rres2;
	 if (rresult == 0.0)
	    return Equal;
	 return ((rresult > 0.0) ? Greater : Less);

      case T_Null:
         return Equal;

      case T_Cset:
         return csetcmp((unsigned int *)((struct b_cset *)BlkLoc(*dp1))->bits,
            (unsigned int *)((struct b_cset *)BlkLoc(*dp2))->bits);

      case T_File:
      case T_Proc:
      case T_List:
      case T_Table:
      case T_Set:
      case T_Record:
      case T_Coexpr:
      case T_External:
	 /*
          * Collate these values according to the relative positions of
          *  their blocks in the heap.
	  */
         lresult = ((long)BlkLoc(*dp1) - (long)BlkLoc(*dp2));
         if (lresult == 0)
            return Equal;
         return ((lresult > 0) ? Greater : Less);

      default:
	 syserr("anycmp: unknown datatype.");
      }
   }

/*
 * order(x) - return collating number for object x.
 */

int order(dp)
dptr dp;
   {
   if (Qual(*dp))
      return 3; 	     /* string */
   switch (Type(*dp)) {
      case T_Null:
	 return 0;
      case T_Integer:
	 return 1;

#ifdef LargeInts
      case T_Bignum:
	 return 1;
#endif					/* LargeInts */

      case T_Real:
	 return 2;
      case T_Cset:
	 return 4;
      case T_Coexpr:
	 return 5;
      case T_File:
	 return 6;
      case T_Proc:
	 return 7;
      case T_List:
	 return 8;
      case T_Table:
	 return 9;
      case T_Set:
	 return 10;
      case T_Record:
	 return 11;
      case T_External:
         return 12;
      default:
	 syserr("order: unknown datatype.");
      }
   }

/*
 * equiv - test equivalence of two objects.
 */

int equiv(dp1, dp2)
dptr dp1, dp2;
   {
   register int result;
   register word i;
   register char *s1, *s2;
   double rres1, rres2;

   result = 0;

      /*
       * If the descriptors are identical, the objects are equivalent.
       */
   if (EqlDesc(*dp1,*dp2))
      result = 1;
   else if (Qual(*dp1) && Qual(*dp2)) {

      /*
       *  If both are strings of equal length, compare their characters.
       */

      if ((i = StrLen(*dp1)) == StrLen(*dp2)) {


	 s1 = StrLoc(*dp1);
	 s2 = StrLoc(*dp2);
	 result = 1;
	 while (i--)
	   if (*s1++ != *s2++) {
	      result = 0;
	      break;
	      }

	 }
      }
   else if (dp1->dword == dp2->dword)
      switch (Type(*dp1)) {
	 /*
	  * For integers and reals, just compare the values.
	  */
	 case T_Integer:
	    result = (IntVal(*dp1) == IntVal(*dp2));
	    break;

#ifdef LargeInts
	 case T_Bignum:
	    result = (bigcmp(dp1, dp2) == 0);
	    break;
#endif					/* LargeInts */


	 case T_Real:
            GetReal(dp1, rres1);
            GetReal(dp2, rres2);
            result = (rres1 == rres2);
	    break;

	 case T_Cset:
	    /*
	     * Compare the bit arrays of the csets.
	     */
	    result = 1;
	    for (i = 0; i < CsetSize; i++)
	       if (BlkLoc(*dp1)->cset.bits[i] != BlkLoc(*dp2)->cset.bits[i]) {
		  result = 0;
		  break;
		  }
	 }
   else
      /*
       * dp1 and dp2 are of different types, so they can't be
       *  equivalent.
       */
      result = 0;

   return result;
   }

/*
 * lexcmp - lexically compare two strings.
 */

int lexcmp(dp1, dp2)
dptr dp1, dp2;
   {


   register char *s1, *s2;
   register word minlen;
   word l1, l2;

   /*
    * Get length and starting address of both strings.
    */
   l1 = StrLen(*dp1);
   s1 = StrLoc(*dp1);
   l2 = StrLen(*dp2);
   s2 = StrLoc(*dp2);

   /*
    * Set minlen to length of the shorter string.
    */
   minlen = Min(l1, l2);

   /*
    * Compare as many bytes as are in the smaller string.  If an
    *  inequality is found, compare the differing bytes.
    */
   while (minlen--)
      if (*s1++ != *s2++)

         return (ToAscii(*--s1 & 0377) > ToAscii(*--s2 & 0377) ?
                 Greater : Less);
   /*
    * The strings compared equal for the length of the shorter.
    */
   if (l1 == l2)
      return Equal;
   else if (l1 > l2)
      return Greater;
   else
      return Less;

   }

/*
 * numcmp - compare two numbers.  Returns -1, 0, 1 for dp1 <, =, > dp2.
 *  dp3 is made into a descriptor for the return value.
 */

int numcmp(dp1, dp2, dp3)
dptr dp1, dp2, dp3;
   {
   int t1, t2;
   double r1, r2;
   /*
    * Be sure that both dp1 and dp2 are numeric.
    */

   if ((t1 = cvnum(dp1)) == CvtFail)
      RetError(102, *dp1);
   if ((t2 = cvnum(dp2)) == CvtFail)
      RetError(102, *dp2);

   if (t1 == T_Integer && t2 == T_Integer) {
   /*
    *  dp1 and dp2 are both integers, compare them and
    *  create an integer descriptor in dp3
    */

      *dp3 = *dp2;
      if (IntVal(*dp1) == IntVal(*dp2))
	 return Equal;
      return ((IntVal(*dp1) > IntVal(*dp2)) ? Greater : Less);
      }
   else if (t1 == T_Real || t2 == T_Real) {

   /*
    *  Either dp1 or dp2 is real. Convert the other to a real,
    *  compare them and create a real descriptor in dp3.
    */

      if (t1 != T_Real) {

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

            r1 = IntVal(*dp1);

         }
      else
	 r1 = BlkLoc(*dp1)->realblk.realval;

      if (t2 != T_Real) {

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

            r2 = IntVal(*dp2);
         }
      else
	 r2 = BlkLoc(*dp2)->realblk.realval;
	 
      if (makereal(r2, dp3) == Error)
         return Error;
      if (r1 == r2)
	 return Equal;
      return ((r1 > r2) ? Greater : Less);
      }
#ifdef LargeInts
   else {
      int result;

      *dp3 = *dp2;
      result = bigcmp(dp1, dp2);
      if (result == 0)
	 return Equal;
      return ((result > 0) ? Greater : Less);
      }
#endif					/* LargeInts */
   }

/*
 * csetcmp - compare two cset bit arrays.
 *  The order defined by this function is identical to the lexical order of
 *  the two strings that the csets would be converted into.
 */

int csetcmp(cs1, cs2)
unsigned int *cs1, *cs2;
   {
   unsigned int nbit, mask, *cs_end;

   if (cs1 == cs2) return Equal;

   /*
    * The longest common prefix of the two bit arrays converts to some
    *  common prefix string.  The first bit on which the csets disagree is
    *  the first character of the conversion strings that disagree, and so this
    *  is the character on which the order is determined.  The cset that has
    *  this first non-common bit = one, has in that position the lowest
    *  character, so this cset is lexically least iff the other cset has some
    *  following bit set.  If the other cset has no bits set after the first
    *  point of disagreement, then it is a prefix of the other, and is therefor
    *  lexically less.
    *
    * Find the first word where cs1 and cs2 are different.
    */
   for (cs_end = cs1 + CsetSize; cs1 < cs_end; cs1++, cs2++)
      if (*cs1 != *cs2) {
	 /*
	  * Let n be the position at which the bits first differ within
	  *  the word.  Set nbit to some integer for which the nth bit
	  *  is the first bit in the word that is one.  Note here and in the
	  *  following, that bits go from right to left within a word, so
	  *  the _first_ bit is the _rightmost_ bit.
	  */
	 nbit = *cs1 ^ *cs2;

	 /* Set mask to an integer that has all zeros in bit positions
	  *  upto and including position n, and all ones in bit positions
	  *  _after_ bit position n.
	  */
	 for (mask = (unsigned)MaxLong << 1; !(~mask & nbit); mask <<= 1);

	 /*
	  * nbit & ~mask contains zeros everywhere except position n, which
	  *  is a one, so *cs2 & (nbit & ~mask) is non-zero iff the nth bit
	  *  of *cs2 is one.
	  */
	 if (*cs2 & (nbit & ~mask)) {
	    /*
	     * If there are bits set in cs1 after bit position n in the
	     *  current word, then cs1 is lexically greater than cs2.
	     */
	    if (*cs1 & mask) return Greater;
	    while (++cs1 < cs_end)
	       if (*cs1) return Greater;

	    /*
	     * Otherwise cs1 is a proper prefix of cs2 and is therefore
	     *  lexically less.
	     */
	     return Less;
	     }

	 /*
	  * If the nth bit of *cs2 isn't one, then the nth bit of cs1
	  *  must be one.  Just reverse the logic for the previous
	  *  case.
	  */
	 if (*cs2 & mask) return Less;
	 cs_end = cs2 + (cs_end - cs1);
	 while (++cs2 < cs_end)
	    if (*cs2) return Less;
	 return Greater;
	 }
   return Equal;
   }