Annotation of 43BSD/contrib/icon/rt/anycmp.c, revision 1.1

1.1     ! root        1: #include "../h/rt.h"
        !             2: 
        !             3: /*
        !             4:  * anycmp - compare any two objects.  The result of the comparison is
        !             5:  *  an integer such that:
        !             6:  *    d1 = d2 -> 0
        !             7:  *    d1 > d2 -> >0  (1 if same type)
        !             8:  *    d1 < d2 -> <0  (-1 if same type)
        !             9:  */
        !            10: 
        !            11: anycmp(d1,d2)
        !            12: struct descrip *d1, *d2;
        !            13:    {
        !            14:    register int o1, o2;
        !            15:    register long lresult;
        !            16:    register double fresult;
        !            17: 
        !            18:    /*
        !            19:     * Get a collating number for d1 and d2.
        !            20:     */
        !            21:    o1 = order(d1);
        !            22:    o2 = order(d2);
        !            23: 
        !            24:    /*
        !            25:     * If d1 and d2 aren't of the same type, return the difference of
        !            26:     *  their collating numbers.
        !            27:     */
        !            28:    if (o1 != o2)
        !            29:       return (o1 - o2);
        !            30: 
        !            31:    if (o1 == D_NULL)
        !            32:       /*
        !            33:        * o1 0, (D_NULL), return 0 because all null values are the same.
        !            34:        */
        !            35:       return (0);
        !            36:    if (o1 == 3)
        !            37:       /*
        !            38:        * d1 and d2 are strings, use lexcmp to compare them.
        !            39:        */
        !            40:       return (lexcmp(d1,d2));
        !            41: 
        !            42:    switch (TYPE(*d1)) {
        !            43:       /*
        !            44:        * For numbers, return -1, 0, 1, depending on whether d1 <, =, > d2.
        !            45:        */
        !            46:       case T_INTEGER:
        !            47:          lresult = INTVAL(*d1) - INTVAL(*d2);
        !            48:          if (lresult == 0)
        !            49:             return (0);
        !            50:          return ((lresult > 0) ? 1 : -1);
        !            51: #ifdef LONGS
        !            52:       case T_LONGINT:
        !            53:          lresult = BLKLOC(*d1)->longint.intval - BLKLOC(*d2)->longint.intval;
        !            54:          if (lresult == 0)
        !            55:             return (0);
        !            56:          return ((lresult > 0) ? 1 : -1);
        !            57: #endif LONGS
        !            58:       case T_REAL:
        !            59:          fresult = BLKLOC(*d1)->realblk.realval - BLKLOC(*d2)->realblk.realval;
        !            60:          if (fresult == 0)
        !            61:             return (0);
        !            62:          return ((fresult > 0) ? 1 : -1);
        !            63: 
        !            64:       case T_CSET:
        !            65:       case T_FILE:
        !            66:       case T_PROC:
        !            67:       case T_LIST:
        !            68:       case T_TABLE:
        !            69: #ifdef SETS
        !            70:       case T_SET:
        !            71: #endif SETS
        !            72:       case T_RECORD:
        !            73:       case T_ESTACK:
        !            74:          /*
        !            75:           * Csets, files, procedures, lists, tables, records, co-expressions
        !            76:           *  and sets have no specified collating sequence so any two of 
        !            77:           *  the same type are considered to be equal.
        !            78:           */
        !            79:          return (0);
        !            80: 
        !            81:       default:
        !            82:          syserr("anycmp: unknown datatype.");
        !            83:       }
        !            84:    }
        !            85: 
        !            86: /*
        !            87:  * order(x) - return collating number for object x.
        !            88:  */
        !            89: 
        !            90: order(d)
        !            91: struct descrip *d;
        !            92:    {
        !            93:    if (QUAL(*d))
        !            94:       if (STRLOC(*d) == 0)
        !            95:          return(0);               /* &null */
        !            96:       else
        !            97:          return (3);              /* some string */
        !            98:    switch (TYPE(*d)) {
        !            99:       case T_INTEGER:
        !           100: #ifdef LONGS
        !           101:       case T_LONGINT:
        !           102: #endif LONGS
        !           103:          return (1);
        !           104:       case T_REAL:
        !           105:          return (2);
        !           106:       case T_CSET:
        !           107:          return (4);
        !           108:       case T_ESTACK:
        !           109:          return (5);
        !           110:       case T_FILE:
        !           111:          return (6);
        !           112:       case T_PROC:
        !           113:          return (7);
        !           114:       case T_LIST:
        !           115:          return (8);
        !           116:       case T_TABLE:
        !           117:          return (9);
        !           118: #ifdef SETS
        !           119:       case T_SET:
        !           120:          return (10);
        !           121: #endif SETS
        !           122:       case T_RECORD:
        !           123:          return (11);
        !           124:       default:
        !           125:          syserr("order: unknown datatype.");
        !           126:       }
        !           127:    }

unix.superglobalmegacorp.com

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