home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Rcomp < prev    next >
Encoding:
Text File  |  1990-07-19  |  9.1 KB  |  425 lines
  1. /*
  2.  * File: rcomp.c
  3.  *  Contents: anycmp, equiv, lexcmp, numcmp
  4.  */
  5.  
  6. #include "../h/config.h"
  7. #include "../h/rt.h"
  8. #include "rproto.h"
  9.  
  10. /*
  11.  * anycmp - compare any two objects.
  12.  */
  13.  
  14. int anycmp(dp1,dp2)
  15. dptr dp1, dp2;
  16.    {
  17.    register int o1, o2;
  18.    register long lresult;
  19.    double rres1, rres2, rresult;
  20.  
  21.    /*
  22.     * Get a collating number for dp1 and dp2.
  23.     */
  24.    o1 = order(dp1);
  25.    o2 = order(dp2);
  26.  
  27.    /*
  28.     * If dp1 and dp2 aren't of the same type, compare their collating numbers.
  29.     */
  30.    if (o1 != o2)
  31.       return (o1 > o2 ? Greater : Less);
  32.  
  33.    if (o1 == 3)
  34.       /*
  35.        * dp1 and dp2 are strings, use lexcmp to compare them.
  36.        */
  37.       return lexcmp(dp1,dp2);
  38.  
  39.    switch (Type(*dp1)) {
  40.       case T_Integer:
  41.      lresult = IntVal(*dp1) - IntVal(*dp2);
  42.      if (lresult == 0)
  43.         return Equal;
  44.      return ((lresult > 0) ? Greater : Less);
  45.  
  46. #ifdef LargeInts
  47.       case T_Bignum:
  48.      lresult = bigcmp(dp1, dp2);
  49.      if (lresult == 0)
  50.         return Equal;
  51.      return ((lresult > 0) ? Greater : Less);
  52. #endif                    /* LargeInts */
  53.  
  54.       case T_Real:
  55.          GetReal(dp1,rres1);
  56.          GetReal(dp2,rres2);
  57.          rresult = rres1 - rres2;
  58.      if (rresult == 0.0)
  59.         return Equal;
  60.      return ((rresult > 0.0) ? Greater : Less);
  61.  
  62.       case T_Null:
  63.          return Equal;
  64.  
  65.       case T_Cset:
  66.          return csetcmp((unsigned int *)((struct b_cset *)BlkLoc(*dp1))->bits,
  67.             (unsigned int *)((struct b_cset *)BlkLoc(*dp2))->bits);
  68.  
  69.       case T_File:
  70.       case T_Proc:
  71.       case T_List:
  72.       case T_Table:
  73.       case T_Set:
  74.       case T_Record:
  75.       case T_Coexpr:
  76.       case T_External:
  77.      /*
  78.           * Collate these values according to the relative positions of
  79.           *  their blocks in the heap.
  80.       */
  81.          lresult = ((long)BlkLoc(*dp1) - (long)BlkLoc(*dp2));
  82.          if (lresult == 0)
  83.             return Equal;
  84.          return ((lresult > 0) ? Greater : Less);
  85.  
  86.       default:
  87.      syserr("anycmp: unknown datatype.");
  88.       }
  89.    }
  90.  
  91. /*
  92.  * order(x) - return collating number for object x.
  93.  */
  94.  
  95. int order(dp)
  96. dptr dp;
  97.    {
  98.    if (Qual(*dp))
  99.       return 3;          /* string */
  100.    switch (Type(*dp)) {
  101.       case T_Null:
  102.      return 0;
  103.       case T_Integer:
  104.      return 1;
  105.  
  106. #ifdef LargeInts
  107.       case T_Bignum:
  108.      return 1;
  109. #endif                    /* LargeInts */
  110.  
  111.       case T_Real:
  112.      return 2;
  113.       case T_Cset:
  114.      return 4;
  115.       case T_Coexpr:
  116.      return 5;
  117.       case T_File:
  118.      return 6;
  119.       case T_Proc:
  120.      return 7;
  121.       case T_List:
  122.      return 8;
  123.       case T_Table:
  124.      return 9;
  125.       case T_Set:
  126.      return 10;
  127.       case T_Record:
  128.      return 11;
  129.       case T_External:
  130.          return 12;
  131.       default:
  132.      syserr("order: unknown datatype.");
  133.       }
  134.    }
  135.  
  136. /*
  137.  * equiv - test equivalence of two objects.
  138.  */
  139.  
  140. int equiv(dp1, dp2)
  141. dptr dp1, dp2;
  142.    {
  143.    register int result;
  144.    register word i;
  145.    register char *s1, *s2;
  146.    double rres1, rres2;
  147.  
  148.    result = 0;
  149.  
  150.       /*
  151.        * If the descriptors are identical, the objects are equivalent.
  152.        */
  153.    if (EqlDesc(*dp1,*dp2))
  154.       result = 1;
  155.    else if (Qual(*dp1) && Qual(*dp2)) {
  156.  
  157.       /*
  158.        *  If both are strings of equal length, compare their characters.
  159.        */
  160.  
  161.       if ((i = StrLen(*dp1)) == StrLen(*dp2)) {
  162.  
  163.  
  164.      s1 = StrLoc(*dp1);
  165.      s2 = StrLoc(*dp2);
  166.      result = 1;
  167.      while (i--)
  168.        if (*s1++ != *s2++) {
  169.           result = 0;
  170.           break;
  171.           }
  172.  
  173.      }
  174.       }
  175.    else if (dp1->dword == dp2->dword)
  176.       switch (Type(*dp1)) {
  177.      /*
  178.       * For integers and reals, just compare the values.
  179.       */
  180.      case T_Integer:
  181.         result = (IntVal(*dp1) == IntVal(*dp2));
  182.         break;
  183.  
  184. #ifdef LargeInts
  185.      case T_Bignum:
  186.         result = (bigcmp(dp1, dp2) == 0);
  187.         break;
  188. #endif                    /* LargeInts */
  189.  
  190.  
  191.      case T_Real:
  192.             GetReal(dp1, rres1);
  193.             GetReal(dp2, rres2);
  194.             result = (rres1 == rres2);
  195.         break;
  196.  
  197.      case T_Cset:
  198.         /*
  199.          * Compare the bit arrays of the csets.
  200.          */
  201.         result = 1;
  202.         for (i = 0; i < CsetSize; i++)
  203.            if (BlkLoc(*dp1)->cset.bits[i] != BlkLoc(*dp2)->cset.bits[i]) {
  204.           result = 0;
  205.           break;
  206.           }
  207.      }
  208.    else
  209.       /*
  210.        * dp1 and dp2 are of different types, so they can't be
  211.        *  equivalent.
  212.        */
  213.       result = 0;
  214.  
  215.    return result;
  216.    }
  217.  
  218. /*
  219.  * lexcmp - lexically compare two strings.
  220.  */
  221.  
  222. int lexcmp(dp1, dp2)
  223. dptr dp1, dp2;
  224.    {
  225.  
  226.  
  227.    register char *s1, *s2;
  228.    register word minlen;
  229.    word l1, l2;
  230.  
  231.    /*
  232.     * Get length and starting address of both strings.
  233.     */
  234.    l1 = StrLen(*dp1);
  235.    s1 = StrLoc(*dp1);
  236.    l2 = StrLen(*dp2);
  237.    s2 = StrLoc(*dp2);
  238.  
  239.    /*
  240.     * Set minlen to length of the shorter string.
  241.     */
  242.    minlen = Min(l1, l2);
  243.  
  244.    /*
  245.     * Compare as many bytes as are in the smaller string.  If an
  246.     *  inequality is found, compare the differing bytes.
  247.     */
  248.    while (minlen--)
  249.       if (*s1++ != *s2++)
  250.  
  251.          return (ToAscii(*--s1 & 0377) > ToAscii(*--s2 & 0377) ?
  252.                  Greater : Less);
  253.    /*
  254.     * The strings compared equal for the length of the shorter.
  255.     */
  256.    if (l1 == l2)
  257.       return Equal;
  258.    else if (l1 > l2)
  259.       return Greater;
  260.    else
  261.       return Less;
  262.  
  263.    }
  264.  
  265. /*
  266.  * numcmp - compare two numbers.  Returns -1, 0, 1 for dp1 <, =, > dp2.
  267.  *  dp3 is made into a descriptor for the return value.
  268.  */
  269.  
  270. int numcmp(dp1, dp2, dp3)
  271. dptr dp1, dp2, dp3;
  272.    {
  273.    int t1, t2;
  274.    double r1, r2;
  275.    /*
  276.     * Be sure that both dp1 and dp2 are numeric.
  277.     */
  278.  
  279.    if ((t1 = cvnum(dp1)) == CvtFail)
  280.       RetError(102, *dp1);
  281.    if ((t2 = cvnum(dp2)) == CvtFail)
  282.       RetError(102, *dp2);
  283.  
  284.    if (t1 == T_Integer && t2 == T_Integer) {
  285.    /*
  286.     *  dp1 and dp2 are both integers, compare them and
  287.     *  create an integer descriptor in dp3
  288.     */
  289.  
  290.       *dp3 = *dp2;
  291.       if (IntVal(*dp1) == IntVal(*dp2))
  292.      return Equal;
  293.       return ((IntVal(*dp1) > IntVal(*dp2)) ? Greater : Less);
  294.       }
  295.    else if (t1 == T_Real || t2 == T_Real) {
  296.  
  297.    /*
  298.     *  Either dp1 or dp2 is real. Convert the other to a real,
  299.     *  compare them and create a real descriptor in dp3.
  300.     */
  301.  
  302.       if (t1 != T_Real) {
  303.  
  304. #ifdef LargeInts
  305.      if (t1 == T_Bignum)
  306.         r1 = bigtoreal(dp1);
  307.      else
  308. #endif                    /* LargeInts */
  309.  
  310.             r1 = IntVal(*dp1);
  311.  
  312.          }
  313.       else
  314.      r1 = BlkLoc(*dp1)->realblk.realval;
  315.  
  316.       if (t2 != T_Real) {
  317.  
  318. #ifdef LargeInts
  319.      if (t2 == T_Bignum)
  320.         r2 = bigtoreal(dp2);
  321.      else
  322. #endif                    /* LargeInts */
  323.  
  324.             r2 = IntVal(*dp2);
  325.          }
  326.       else
  327.      r2 = BlkLoc(*dp2)->realblk.realval;
  328.      
  329.       if (makereal(r2, dp3) == Error)
  330.          return Error;
  331.       if (r1 == r2)
  332.      return Equal;
  333.       return ((r1 > r2) ? Greater : Less);
  334.       }
  335. #ifdef LargeInts
  336.    else {
  337.       int result;
  338.  
  339.       *dp3 = *dp2;
  340.       result = bigcmp(dp1, dp2);
  341.       if (result == 0)
  342.      return Equal;
  343.       return ((result > 0) ? Greater : Less);
  344.       }
  345. #endif                    /* LargeInts */
  346.    }
  347.  
  348. /*
  349.  * csetcmp - compare two cset bit arrays.
  350.  *  The order defined by this function is identical to the lexical order of
  351.  *  the two strings that the csets would be converted into.
  352.  */
  353.  
  354. int csetcmp(cs1, cs2)
  355. unsigned int *cs1, *cs2;
  356.    {
  357.    unsigned int nbit, mask, *cs_end;
  358.  
  359.    if (cs1 == cs2) return Equal;
  360.  
  361.    /*
  362.     * The longest common prefix of the two bit arrays converts to some
  363.     *  common prefix string.  The first bit on which the csets disagree is
  364.     *  the first character of the conversion strings that disagree, and so this
  365.     *  is the character on which the order is determined.  The cset that has
  366.     *  this first non-common bit = one, has in that position the lowest
  367.     *  character, so this cset is lexically least iff the other cset has some
  368.     *  following bit set.  If the other cset has no bits set after the first
  369.     *  point of disagreement, then it is a prefix of the other, and is therefor
  370.     *  lexically less.
  371.     *
  372.     * Find the first word where cs1 and cs2 are different.
  373.     */
  374.    for (cs_end = cs1 + CsetSize; cs1 < cs_end; cs1++, cs2++)
  375.       if (*cs1 != *cs2) {
  376.      /*
  377.       * Let n be the position at which the bits first differ within
  378.       *  the word.  Set nbit to some integer for which the nth bit
  379.       *  is the first bit in the word that is one.  Note here and in the
  380.       *  following, that bits go from right to left within a word, so
  381.       *  the _first_ bit is the _rightmost_ bit.
  382.       */
  383.      nbit = *cs1 ^ *cs2;
  384.  
  385.      /* Set mask to an integer that has all zeros in bit positions
  386.       *  upto and including position n, and all ones in bit positions
  387.       *  _after_ bit position n.
  388.       */
  389.      for (mask = (unsigned)MaxLong << 1; !(~mask & nbit); mask <<= 1);
  390.  
  391.      /*
  392.       * nbit & ~mask contains zeros everywhere except position n, which
  393.       *  is a one, so *cs2 & (nbit & ~mask) is non-zero iff the nth bit
  394.       *  of *cs2 is one.
  395.       */
  396.      if (*cs2 & (nbit & ~mask)) {
  397.         /*
  398.          * If there are bits set in cs1 after bit position n in the
  399.          *  current word, then cs1 is lexically greater than cs2.
  400.          */
  401.         if (*cs1 & mask) return Greater;
  402.         while (++cs1 < cs_end)
  403.            if (*cs1) return Greater;
  404.  
  405.         /*
  406.          * Otherwise cs1 is a proper prefix of cs2 and is therefore
  407.          *  lexically less.
  408.          */
  409.          return Less;
  410.          }
  411.  
  412.      /*
  413.       * If the nth bit of *cs2 isn't one, then the nth bit of cs1
  414.       *  must be one.  Just reverse the logic for the previous
  415.       *  case.
  416.       */
  417.      if (*cs2 & mask) return Less;
  418.      cs_end = cs2 + (cs_end - cs1);
  419.      while (++cs2 < cs_end)
  420.         if (*cs2) return Less;
  421.      return Greater;
  422.      }
  423.    return Equal;
  424.    }
  425.