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