Return to rcomp.c CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx

Annotation of researchv10dc/cmd/icon/src/iconx/rcomp.c, revision 1.1

1.1     ! root        1: /*
        !             2:  * File: rcomp.c
        !             3:  *  Contents: anycmp, equiv, lexcmp, numcmp
        !             4:  */
        !             5: 
        !             6: #include "../h/rt.h"
        !             7: 
        !             8: /*
        !             9:  * anycmp - compare any two objects.  The result of the comparison is
        !            10:  *  an integer such that:
        !            11:  *    d1 = d2 -> 0
        !            12:  *    d1 > d2 -> >0  (1 if same type)
        !            13:  *    d1 < d2 -> <0  (-1 if same type)
        !            14:  */
        !            15: 
        !            16: anycmp(d1,d2)
        !            17: struct descrip *d1, *d2;
        !            18:    {
        !            19:    register int o1, o2;
        !            20:    register long lresult;
        !            21:    double rres1, rres2, rresult;
        !            22: 
        !            23:    /*
        !            24:     * Get a collating number for d1 and d2.
        !            25:     */
        !            26:    o1 = order(d1);
        !            27:    o2 = order(d2);
        !            28: 
        !            29:    /*
        !            30:     * If d1 and d2 aren't of the same type, return the difference of
        !            31:     *  their collating numbers.
        !            32:     */
        !            33:    if (o1 != o2)
        !            34:       return (o1 - o2);
        !            35: 
        !            36:    if (o1 == D_Null)
        !            37:       /*
        !            38:        * o1 0, (D_Null), return 0 because all null values are the same.
        !            39:        */
        !            40:       return 0;
        !            41:    if (o1 == 3)
        !            42:       /*
        !            43:        * d1 and d2 are strings, use lexcmp to compare them.
        !            44:        */
        !            45:       return lexcmp(d1,d2);
        !            46: 
        !            47:    switch (Type(*d1)) {
        !            48:       /*
        !            49:        * For numbers, return -1, 0, 1, depending on whether d1 <, =, > d2.
        !            50:        */
        !            51:       case T_Integer:
        !            52:         lresult = IntVal(*d1) - IntVal(*d2);
        !            53:         if (lresult == 0)
        !            54:            return 0;
        !            55:         return ((lresult > 0) ? 1 : -1);
        !            56: 
        !            57:       case T_Longint:
        !            58:         lresult = BlkLoc(*d1)->longint.intval - BlkLoc(*d2)->longint.intval;
        !            59:         if (lresult == 0)
        !            60:            return 0;
        !            61:         return ((lresult > 0) ? 1 : -1);
        !            62: 
        !            63:       case T_Real:
        !            64:          GetReal(d1,rres1);
        !            65:          GetReal(d2,rres2);
        !            66:          rresult = rres1 - rres2;
        !            67:         if (rresult == 0)
        !            68:            return 0;
        !            69:         return ((rresult > 0) ? 1 : -1);
        !            70: 
        !            71:       case T_Cset:
        !            72:       case T_File:
        !            73:       case T_Proc:
        !            74:       case T_List:
        !            75:       case T_Table:
        !            76:       case T_Set:
        !            77:       case T_Record:
        !            78:       case T_Coexpr:
        !            79:         /*
        !            80:          * Csets, files, procedures, lists, tables, records, co-expressions
        !            81:          *  and sets have no specified collating sequence so any two of
        !            82:          *  the same type are considered to be equal.
        !            83:          */
        !            84:         return 0;
        !            85: 
        !            86:       default:
        !            87:         syserr("anycmp: unknown datatype.");
        !            88:       }
        !            89:    }
        !            90: 
        !            91: /*
        !            92:  * order(x) - return collating number for object x.
        !            93:  */
        !            94: 
        !            95: order(d)
        !            96: struct descrip *d;
        !            97:    {
        !            98:    if (Qual(*d))
        !            99:       return 3;             /* string */
        !           100:    switch (Type(*d)) {
        !           101:       case T_Null:
        !           102:         return 0;
        !           103:       case T_Integer:
        !           104:       case T_Longint:
        !           105:         return 1;
        !           106:       case T_Real:
        !           107:         return 2;
        !           108:       case T_Cset:
        !           109:         return 4;
        !           110:       case T_Coexpr:
        !           111:         return 5;
        !           112:       case T_File:
        !           113:         return 6;
        !           114:       case T_Proc:
        !           115:         return 7;
        !           116:       case T_List:
        !           117:         return 8;
        !           118:       case T_Table:
        !           119:         return 9;
        !           120:       case T_Set:
        !           121:         return 10;
        !           122:       case T_Record:
        !           123:         return 11;
        !           124:       default:
        !           125:         syserr("order: unknown datatype.");
        !           126:       }
        !           127:    }
        !           128: 
        !           129: 
        !           130: /*
        !           131:  * equiv - test equivalence of two objects.
        !           132:  */
        !           133: 
        !           134: equiv(dp1, dp2)
        !           135: struct descrip *dp1, *dp2;
        !           136:    {
        !           137:    register int result, i;
        !           138:    register char *s1, *s2;
        !           139:    double rres1, rres2;
        !           140: 
        !           141:    result = 0;
        !           142: 
        !           143:       /*
        !           144:        * If the descriptors are identical, the objects are equivalent.
        !           145:        */
        !           146:    if (EqlDesc(*dp1,*dp2))
        !           147:       result = 1;
        !           148:    else if (Qual(*dp1) && Qual(*dp2)) {
        !           149: 
        !           150:       /*
        !           151:        *  If both are strings of equal length, compare their characters.
        !           152:        */
        !           153: 
        !           154:       if ((i = StrLen(*dp1)) == StrLen(*dp2)) {
        !           155:         s1 = StrLoc(*dp1);
        !           156:         s2 = StrLoc(*dp2);
        !           157:         result = 1;
        !           158:         while (i--)
        !           159:           if (*s1++ != *s2++) {
        !           160:              result = 0;
        !           161:              break;
        !           162:              }
        !           163:         }
        !           164:       }
        !           165:    else if (dp1->dword == dp2->dword)
        !           166:       switch (Type(*dp1)) {
        !           167:         /*
        !           168:          * For integers and reals, just compare the values.
        !           169:          */
        !           170:         case T_Integer:
        !           171:            result = (IntVal(*dp1) == IntVal(*dp2));
        !           172:            break;
        !           173: 
        !           174:         case T_Longint:
        !           175:            result =
        !           176:               (BlkLoc(*dp1)->longint.intval == BlkLoc(*dp2)->longint.intval);
        !           177:            break;
        !           178: 
        !           179:         case T_Real:
        !           180:             GetReal(dp1, rres1);
        !           181:             GetReal(dp2, rres2);
        !           182:             result = (rres1 == rres2);
        !           183:            break;
        !           184: 
        !           185:         case T_Cset:
        !           186:            /*
        !           187:             * Compare the bit arrays of the csets.
        !           188:             */
        !           189:            result = 1;
        !           190:            for (i = 0; i < CsetSize; i++)
        !           191:               if (BlkLoc(*dp1)->cset.bits[i] != BlkLoc(*dp2)->cset.bits[i]) {
        !           192:                  result = 0;
        !           193:                  break;
        !           194:                  }
        !           195:         }
        !           196:    else
        !           197:       /*
        !           198:        * dp1 and dp2 are of different types, so they can't be
        !           199:        *  equivalent.
        !           200:        */
        !           201:       result = 0;
        !           202: 
        !           203:    return result;
        !           204:    }
        !           205: 
        !           206: 
        !           207: /*
        !           208:  * lexcmp - lexically compare two strings.
        !           209:  */
        !           210: 
        !           211: lexcmp(d1, d2)
        !           212: struct descrip *d1, *d2;
        !           213:    {
        !           214:    register char *s1, *s2;
        !           215:    register int minlen;
        !           216:    int l1, l2;
        !           217: 
        !           218:    /*
        !           219:     * Get length and starting address of both strings.
        !           220:     */
        !           221:    l1 = StrLen(*d1);
        !           222:    s1 = StrLoc(*d1);
        !           223:    l2 = StrLen(*d2);
        !           224:    s2 = StrLoc(*d2);
        !           225: 
        !           226:    /*
        !           227:     * Set minlen to length of the shorter string.
        !           228:     */
        !           229:    minlen = (l1 <= l2) ? l1 : l2;
        !           230: 
        !           231:    /*
        !           232:     * Compare as many bytes as are in the smaller string.  If an
        !           233:     *  inequality is found, return the difference of the differing
        !           234:     *  bytes.
        !           235:     */
        !           236:    while (minlen--)
        !           237:       if (*s1++ != *s2++)
        !           238:         return (int)((*--s1 & 0377) - (*--s2 & 0377));
        !           239: 
        !           240:    /*
        !           241:     * The strings compared equal for the length of the shorter.  Return
        !           242:     *  the difference in their lengths.  (Thus, the strings must be of
        !           243:     *  the same length to be equal.)
        !           244:     */
        !           245:    return (l1 - l2);
        !           246:    }
        !           247: 
        !           248: 
        !           249: /*
        !           250:  * numcmp - compare two numbers.  Returns -1, 0, 1 for dp1 <, =, > dp2.
        !           251:  *  dp3 is made into a descriptor for the return value.
        !           252:  */
        !           253: 
        !           254: numcmp(dp1, dp2, dp3)
        !           255: struct descrip *dp1, *dp2, *dp3;
        !           256:    {
        !           257:    register int result;
        !           258:    union numeric n1, n2;
        !           259:    int t1, t2;
        !           260:    /*
        !           261:     * Be sure that both dp1 and dp2 are numeric.
        !           262:     */
        !           263: 
        !           264:    if ((t1 = cvnum(dp1, &n1)) == NULL)
        !           265:       runerr(102, dp1);
        !           266:    if ((t2 = cvnum(dp2, &n2)) == NULL)
        !           267:       runerr(102, dp2);
        !           268: 
        !           269:    if (!(t1 == T_Real || t2 == T_Real)) {
        !           270:    /*
        !           271:     *  dp1 and dp2 are both integers, compare them and
        !           272:     *  create an integer descriptor in dp3
        !           273:     */
        !           274: 
        !           275:          result = 0;
        !           276:          if (n1.integer < n2.integer) result = -1;
        !           277:          else if (n1.integer != n2.integer) result = 1;
        !           278:       Mkint(n2.integer, dp3);
        !           279:       }
        !           280:    else {
        !           281: 
        !           282:    /*
        !           283:     *  Either dp1 or dp2 is real. Convert the other to a real,
        !           284:     *  compare them and create a real descriptor in dp3.
        !           285:     */
        !           286: 
        !           287:       if (!(t1 == T_Real))
        !           288:         n1.real = n1.integer;
        !           289:       if (!(t2 == T_Real))
        !           290:         n2.real = n2.integer;
        !           291:          result = 0;
        !           292:          if (n1.real < n2.real) result = -1;
        !           293:          else if (n1.real != n2.real) result = 1;
        !           294:       mkreal(n2.real, dp3);
        !           295:       }
        !           296: 
        !           297:    return result;            /* return result in r0 */
        !           298:    }
        !           299: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.