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