Source Jam - slang-2.0.6

00001 /* -*- c -*- */
00002 
00003 /* This include file is a template for defining arithmetic binary operations 
00004  * on arithmetic types.  I realize that doing it this way is not very
00005  * elegant but it minimizes the number of lines of code and I believe it 
00006  * promotes clarity.
00007  */
00008 
00009 /* The following macros should be properly defined before including this file:
00010  *
00011  *   GENERIC_BINARY_FUNCTION:   The name of the binary function
00012  *   GENERIC_TYPE:              The class data type
00013  *   MOD_FUNCTION:              The function to use for mod
00014  *   ABS_FUNCTION:              Name of the abs function
00015  *   SIGN_FUNCTION:             Name of the sign function
00016  *   GENERIC_UNARY_FUNCTION     Name of the unary function
00017  *
00018  * If GENERIC_BIT_OPERATIONS is defined, the bit-level binary operators 
00019  * will get included.  If the data type has a power operation (SLANG_POW), 
00020  * then POW_FUNCTION should be defined to return POW_RESULT_TYPE.
00021  * If division by zero errors should be trapped, the define TRAP_DIV_ZERO to 1
00022  */
00023 #ifdef GENERIC_BINARY_FUNCTION
00024 
00025 static int GENERIC_BINARY_FUNCTION 
00026 (int op,
00027  SLtype a_type, VOID_STAR ap, unsigned int na,
00028  SLtype b_type, VOID_STAR bp, unsigned int nb,
00029  VOID_STAR cp)
00030 {
00031    GENERIC_TYPE *c, *a, *b;
00032 #ifdef POW_FUNCTION
00033    POW_RESULT_TYPE *d;
00034 #endif
00035    unsigned int n;
00036 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00037    unsigned int n_max, da, db;
00038 #endif
00039    char *cc;
00040 
00041    (void) a_type;                      /* Both SLANG_INT_TYPE */
00042    (void) b_type;
00043 
00044    a = (GENERIC_TYPE *) ap;
00045    b = (GENERIC_TYPE *) bp;
00046    c = (GENERIC_TYPE *) cp;
00047    cc = (char *) cp;
00048 
00049 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00050    if (na == 1) da = 0; else da = 1;
00051    if (nb == 1) db = 0; else db = 1;
00052 
00053    if (na > nb) n_max = na; else n_max = nb;
00054 #endif
00055 
00056    switch (op)
00057      {
00058       default:
00059         return 0;
00060 #ifdef POW_FUNCTION
00061       case SLANG_POW:
00062         d = (POW_RESULT_TYPE *) cp;
00063 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00064         for (n = 0; n < n_max; n++)
00065           {
00066              d[n] = POW_FUNCTION(*a, *b);
00067              a += da; b += db;
00068           }
00069 #else
00070         if (na == nb)
00071           {
00072              for (n = 0; n < na; n++)
00073                d[n] = POW_FUNCTION(a[n],b[n]);
00074           }
00075         else if (nb == 1)
00076           {
00077              GENERIC_TYPE xb = *b;
00078              if (xb == 2)
00079                for (n = 0; n < na; n++)
00080                  d[n] = a[n] * a[n];
00081              else
00082                for (n = 0; n < na; n++)
00083                  d[n] = POW_FUNCTION(a[n], xb);
00084           }
00085         else /* if (na == 1) */
00086           {
00087              GENERIC_TYPE xa = *a;
00088              for (n = 0; n < nb; n++)
00089                d[n] = POW_FUNCTION(xa, b[n]);
00090           }
00091 #endif
00092         break;
00093 #endif
00094       case SLANG_PLUS:
00095 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00096         for (n = 0; n < n_max; n++)
00097           {
00098              c[n] = (*a + *b); a += da; b += db;
00099           }
00100 #else
00101         if (na == nb)
00102           {
00103              for (n = 0; n < na; n++)
00104                c[n] = a[n] + b[n];
00105           }
00106         else if (nb == 1)
00107           {
00108              GENERIC_TYPE xb = *b;
00109              for (n = 0; n < na; n++)
00110                c[n] = a[n] + xb;
00111           }
00112         else /* if (na == 1) */
00113           {
00114              GENERIC_TYPE xa = *a;
00115              for (n = 0; n < nb; n++)
00116                c[n] = xa + b[n];
00117           }
00118 #endif
00119         break;
00120 
00121       case SLANG_MINUS:
00122 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00123         for (n = 0; n < n_max; n++)
00124           {
00125              c[n] = (*a - *b); a += da; b += db;
00126           }
00127 #else
00128         if (na == nb)
00129           {
00130              for (n = 0; n < na; n++)
00131                c[n] = a[n] - b[n];
00132           }
00133         else if (nb == 1)
00134           {
00135              GENERIC_TYPE xb = *b;
00136              for (n = 0; n < na; n++)
00137                c[n] = a[n] - xb;
00138           }
00139         else /* if (na == 1) */
00140           {
00141              GENERIC_TYPE xa = *a;
00142              for (n = 0; n < nb; n++)
00143                c[n] = xa - b[n];
00144           }
00145 #endif
00146         break;
00147 
00148       case SLANG_TIMES:
00149 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00150         for (n = 0; n < n_max; n++)
00151           {
00152              c[n] = (*a * *b); a += da; b += db;
00153           }
00154 #else
00155         if (na == nb)
00156           {
00157              for (n = 0; n < na; n++)
00158                c[n] = a[n] * b[n];
00159           }
00160         else if (nb == 1)
00161           {
00162              GENERIC_TYPE xb = *b;
00163              for (n = 0; n < na; n++)
00164                c[n] = a[n] * xb;
00165           }
00166         else /* if (na == 1) */
00167           {
00168              GENERIC_TYPE xa = *a;
00169              for (n = 0; n < nb; n++)
00170                c[n] = xa * b[n];
00171           }
00172 #endif
00173         break;
00174 
00175       case SLANG_DIVIDE:
00176 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00177         for (n = 0; n < n_max; n++)
00178           {
00179 #if TRAP_DIV_ZERO
00180              if (*b == 0)
00181                {
00182                   SLang_set_error (SL_DIVIDE_ERROR);
00183                   return -1;
00184                }
00185 #endif
00186              c[n] = (*a / *b); a += da; b += db;
00187           }
00188 #else
00189         if (na == nb)
00190           {
00191              for (n = 0; n < na; n++)
00192                {
00193 #if TRAP_DIV_ZERO
00194                   if (b[n] == 0)
00195                     {
00196                        SLang_set_error (SL_DIVIDE_ERROR);
00197                        return -1;
00198                     }
00199 #endif
00200                   c[n] = a[n] / b[n];
00201                }
00202           }
00203         else if (nb == 1)
00204           {
00205              GENERIC_TYPE xb = *b;
00206 #if TRAP_DIV_ZERO            
00207              if (xb == 0)
00208                {
00209                   SLang_set_error (SL_DIVIDE_ERROR);
00210                   return -1;
00211                }
00212 #endif
00213              for (n = 0; n < na; n++)
00214                c[n] = a[n] / xb;
00215           }
00216         else /* if (na == 1) */
00217           {
00218              GENERIC_TYPE xa = *a;
00219              for (n = 0; n < nb; n++)
00220                {
00221 #if TRAP_DIV_ZERO
00222                   if (b[n] == 0)
00223                     {
00224                        SLang_set_error (SL_DIVIDE_ERROR);
00225                        return -1;
00226                     }
00227 #endif
00228                   c[n] = xa / b[n];
00229                }
00230           }
00231 #endif
00232         break;
00233              
00234       case SLANG_MOD:
00235 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00236         for (n = 0; n < n_max; n++)
00237           {
00238 #if TRAP_DIV_ZERO
00239              if (*b == 0)
00240                {
00241                   SLang_set_error (SL_DIVIDE_ERROR);
00242                   return -1;
00243                }
00244 #endif
00245              c[n] = MOD_FUNCTION(*a, *b); a += da; b += db;
00246           }
00247 #else
00248         if (na == nb)
00249           {
00250              for (n = 0; n < na; n++)
00251                {
00252 #if TRAP_DIV_ZERO
00253                   if (b[n] == 0)
00254                     {
00255                        SLang_set_error (SL_DIVIDE_ERROR);
00256                        return -1;
00257                     }
00258 #endif
00259                   c[n] = MOD_FUNCTION(a[n],b[n]);
00260                }
00261           }
00262         else if (nb == 1)
00263           {
00264              GENERIC_TYPE xb = *b;
00265 #if TRAP_DIV_ZERO
00266              if (xb == 0)
00267                {
00268                   SLang_set_error (SL_DIVIDE_ERROR);
00269                   return -1;
00270                }
00271 #endif
00272              for (n = 0; n < na; n++)
00273                c[n] = MOD_FUNCTION(a[n],xb);
00274           }
00275         else /* if (na == 1) */
00276           {
00277              GENERIC_TYPE xa = *a;
00278              for (n = 0; n < nb; n++)
00279                {
00280 #if TRAP_DIV_ZERO
00281                   if (b[n] == 0)
00282                     {
00283                        SLang_set_error (SL_DIVIDE_ERROR);
00284                        return -1;
00285                     }
00286 #endif
00287                   c[n] = MOD_FUNCTION(xa,b[n]);
00288                }
00289           }
00290 #endif
00291         break;
00292 
00293 #ifdef GENERIC_BIT_OPERATIONS
00294       case SLANG_BAND:
00295 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00296         for (n = 0; n < n_max; n++)
00297           {
00298              c[n] = (*a & *b); a += da; b += db;
00299           }
00300 #else
00301         if (na == nb)
00302           {
00303              for (n = 0; n < na; n++)
00304                c[n] = a[n] & b[n];
00305           }
00306         else if (nb == 1)
00307           {
00308              GENERIC_TYPE xb = *b;
00309              for (n = 0; n < na; n++)
00310                c[n] = a[n] & xb;
00311           }
00312         else /* if (na == 1) */
00313           {
00314              GENERIC_TYPE xa = *a;
00315              for (n = 0; n < nb; n++)
00316                c[n] = xa & b[n];
00317           }
00318 #endif
00319         break;
00320 
00321       case SLANG_BXOR:
00322 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00323         for (n = 0; n < n_max; n++)
00324           {
00325              c[n] = (*a ^ *b); a += da; b += db;
00326           }
00327 #else
00328         if (na == nb)
00329           {
00330              for (n = 0; n < na; n++)
00331                c[n] = a[n] ^ b[n];
00332           }
00333         else if (nb == 1)
00334           {
00335              GENERIC_TYPE xb = *b;
00336              for (n = 0; n < na; n++)
00337                c[n] = a[n] ^ xb;
00338           }
00339         else /* if (na == 1) */
00340           {
00341              GENERIC_TYPE xa = *a;
00342              for (n = 0; n < nb; n++)
00343                c[n] = xa ^ b[n];
00344           }
00345 #endif
00346         break;
00347 
00348       case SLANG_BOR:
00349 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00350         for (n = 0; n < n_max; n++)
00351           {
00352              c[n] = (*a | *b); a += da; b += db;
00353           }
00354 #else
00355         if (na == nb)
00356           {
00357              for (n = 0; n < na; n++)
00358                c[n] = a[n] | b[n];
00359           }
00360         else if (nb == 1)
00361           {
00362              GENERIC_TYPE xb = *b;
00363              for (n = 0; n < na; n++)
00364                c[n] = a[n] | xb;
00365           }
00366         else /* if (na == 1) */
00367           {
00368              GENERIC_TYPE xa = *a;
00369              for (n = 0; n < nb; n++)
00370                c[n] = xa | b[n];
00371           }
00372 #endif
00373         break;
00374 
00375       case SLANG_SHL:
00376 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00377         for (n = 0; n < n_max; n++)
00378           {
00379              c[n] = (*a << *b); a += da; b += db;
00380           }
00381 #else
00382         if (na == nb)
00383           {
00384              for (n = 0; n < na; n++)
00385                c[n] = a[n] << b[n];
00386           }
00387         else if (nb == 1)
00388           {
00389              GENERIC_TYPE xb = *b;
00390              for (n = 0; n < na; n++)
00391                c[n] = a[n] << xb;
00392           }
00393         else /* if (na == 1) */
00394           {
00395              GENERIC_TYPE xa = *a;
00396              for (n = 0; n < nb; n++)
00397                c[n] = xa << b[n];
00398           }
00399 #endif
00400         break;
00401 
00402       case SLANG_SHR:
00403 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00404         for (n = 0; n < n_max; n++)
00405           {
00406              c[n] = (*a >> *b); a += da; b += db;
00407           }
00408 #else
00409         if (na == nb)
00410           {
00411              for (n = 0; n < na; n++)
00412                c[n] = a[n] >> b[n];
00413           }
00414         else if (nb == 1)
00415           {
00416              GENERIC_TYPE xb = *b;
00417              for (n = 0; n < na; n++)
00418                c[n] = a[n] >> xb;
00419           }
00420         else /* if (na == 1) */
00421           {
00422              GENERIC_TYPE xa = *a;
00423              for (n = 0; n < nb; n++)
00424                c[n] = xa >> b[n];
00425           }
00426 #endif
00427         break;
00428 #endif                                 /* GENERIC_BIT_OPERATIONS */
00429       case SLANG_EQ:
00430 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00431         for (n = 0; n < n_max; n++)
00432           {
00433              cc[n] = (*a == *b); a += da; b += db;
00434           }
00435 #else
00436         if (na == nb)
00437           {
00438              for (n = 0; n < na; n++)
00439                cc[n] = (a[n] == b[n]);
00440           }
00441         else if (nb == 1)
00442           {
00443              GENERIC_TYPE xb = *b;
00444              for (n = 0; n < na; n++)
00445                cc[n] = (a[n] == xb);
00446           }
00447         else /* if (na == 1) */
00448           {
00449              GENERIC_TYPE xa = *a;
00450              for (n = 0; n < nb; n++)
00451                cc[n] = (xa == b[n]);
00452           }
00453 #endif
00454         break;
00455 
00456       case SLANG_NE:
00457 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00458         for (n = 0; n < n_max; n++)
00459           {
00460              cc[n] = (*a != *b); a += da; b += db;
00461           }
00462 #else
00463         if (na == nb)
00464           {
00465              for (n = 0; n < na; n++)
00466                cc[n] = (a[n] != b[n]);
00467           }
00468         else if (nb == 1)
00469           {
00470              GENERIC_TYPE xb = *b;
00471              for (n = 0; n < na; n++)
00472                cc[n] = (a[n] != xb);
00473           }
00474         else /* if (na == 1) */
00475           {
00476              GENERIC_TYPE xa = *a;
00477              for (n = 0; n < nb; n++)
00478                cc[n] = (xa != b[n]);
00479           }
00480 #endif
00481         break;
00482 
00483       case SLANG_GT:
00484 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00485         for (n = 0; n < n_max; n++)
00486           {
00487              cc[n] = (*a > *b); a += da; b += db;
00488           }
00489 #else
00490         if (na == nb)
00491           {
00492              for (n = 0; n < na; n++)
00493                cc[n] = (a[n] > b[n]);
00494           }
00495         else if (nb == 1)
00496           {
00497              GENERIC_TYPE xb = *b;
00498              for (n = 0; n < na; n++)
00499                cc[n] = (a[n] > xb);
00500           }
00501         else /* if (na == 1) */
00502           {
00503              GENERIC_TYPE xa = *a;
00504              for (n = 0; n < nb; n++)
00505                cc[n] = (xa > b[n]);
00506           }
00507 #endif
00508         break;
00509 
00510       case SLANG_GE:
00511 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00512         for (n = 0; n < n_max; n++)
00513           {
00514              cc[n] = (*a >= *b); a += da; b += db;
00515           }
00516 #else
00517         if (na == nb)
00518           {
00519              for (n = 0; n < na; n++)
00520                cc[n] = (a[n] >= b[n]);
00521           }
00522         else if (nb == 1)
00523           {
00524              GENERIC_TYPE xb = *b;
00525              for (n = 0; n < na; n++)
00526                cc[n] = (a[n] >= xb);
00527           }
00528         else /* if (na == 1) */
00529           {
00530              GENERIC_TYPE xa = *a;
00531              for (n = 0; n < nb; n++)
00532                cc[n] = (xa >= b[n]);
00533           }
00534 #endif
00535         break;
00536 
00537       case SLANG_LT:
00538 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00539         for (n = 0; n < n_max; n++)
00540           {
00541              cc[n] = (*a < *b); a += da; b += db;
00542           }
00543 #else
00544         if (na == nb)
00545           {
00546              for (n = 0; n < na; n++)
00547                cc[n] = (a[n] < b[n]);
00548           }
00549         else if (nb == 1)
00550           {
00551              GENERIC_TYPE xb = *b;
00552              for (n = 0; n < na; n++)
00553                cc[n] = (a[n] < xb);
00554           }
00555         else /* if (na == 1) */
00556           {
00557              GENERIC_TYPE xa = *a;
00558              for (n = 0; n < nb; n++)
00559                cc[n] = (xa < b[n]);
00560           }
00561 #endif
00562         break;
00563 
00564       case SLANG_LE:
00565 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00566         for (n = 0; n < n_max; n++)
00567           {
00568              cc[n] = (*a <= *b); a += da; b += db;
00569           }
00570 #else
00571         if (na == nb)
00572           {
00573              for (n = 0; n < na; n++)
00574                cc[n] = (a[n] <= b[n]);
00575           }
00576         else if (nb == 1)
00577           {
00578              GENERIC_TYPE xb = *b;
00579              for (n = 0; n < na; n++)
00580                cc[n] = (a[n] <= xb);
00581           }
00582         else /* if (na == 1) */
00583           {
00584              GENERIC_TYPE xa = *a;
00585              for (n = 0; n < nb; n++)
00586                cc[n] = (xa <= b[n]);
00587           }
00588 #endif
00589         break;
00590 
00591       case SLANG_OR:
00592 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00593         for (n = 0; n < n_max; n++)
00594           {
00595              cc[n] = (*a || *b); a += da; b += db;
00596           }
00597 #else
00598         if (na == nb)
00599           {
00600              for (n = 0; n < na; n++)
00601                cc[n] = (a[n] || b[n]);
00602           }
00603         else if (nb == 1)
00604           {
00605              GENERIC_TYPE xb = *b;
00606              for (n = 0; n < na; n++)
00607                cc[n] = (a[n] || xb);
00608           }
00609         else /* if (na == 1) */
00610           {
00611              GENERIC_TYPE xa = *a;
00612              for (n = 0; n < nb; n++)
00613                cc[n] = (xa || b[n]);
00614           }
00615 #endif
00616         break;
00617 
00618       case SLANG_AND:
00619 #if SLANG_OPTIMIZE_FOR_SPEED < 2
00620         for (n = 0; n < n_max; n++)
00621           {
00622              cc[n] = (*a && *b); a += da; b += db;
00623           }
00624 #else
00625         if (na == nb)
00626           {
00627              for (n = 0; n < na; n++)
00628                cc[n] = (a[n] && b[n]);
00629           }
00630         else if (nb == 1)
00631           {
00632              GENERIC_TYPE xb = *b;
00633              for (n = 0; n < na; n++)
00634                cc[n] = (a[n] && xb);
00635           }
00636         else /* if (na == 1) */
00637           {
00638              GENERIC_TYPE xa = *a;
00639              for (n = 0; n < nb; n++)
00640                cc[n] = (xa && b[n]);
00641           }
00642 #endif
00643         break;
00644      }
00645    return 1;
00646 }
00647 
00648 #endif                                 /* GENERIC_BINARY_FUNCTION */
00649 
00650 
00651 #ifdef GENERIC_UNARY_FUNCTION
00652 
00653 static int GENERIC_UNARY_FUNCTION
00654 (int op,
00655  SLtype a_type, VOID_STAR ap, unsigned int na,
00656  VOID_STAR bp
00657  )
00658 {
00659    GENERIC_TYPE *a, *b;
00660    unsigned int n;
00661    int *ib;
00662    char *cb;
00663 
00664    (void) a_type;
00665 
00666    a = (GENERIC_TYPE *) ap;
00667    b = (GENERIC_TYPE *) bp;
00668 
00669    switch (op)
00670      {
00671       default:
00672         return 0;
00673 
00674       case SLANG_PLUSPLUS:
00675         for (n = 0; n < na; n++) b[n] = (a[n] + 1);
00676         break;
00677       case SLANG_MINUSMINUS:
00678         for (n = 0; n < na; n++) b[n] = (a[n] - 1);
00679         break;
00680       case SLANG_ABS:
00681         for (n = 0; n < na; n++) b[n] = ABS_FUNCTION (a[n]);
00682         break;
00683       case SLANG_SIGN:
00684         ib = (int *) bp;
00685         for (n = 0; n < na; n++)
00686           ib[n] = SIGN_FUNCTION(a[n]);
00687         break;
00688       case SLANG_SQR:
00689         for (n = 0; n < na; n++) b[n] = (a[n] * a[n]);
00690         break;
00691       case SLANG_MUL2:
00692         for (n = 0; n < na; n++) b[n] = (2 * a[n]);
00693         break;
00694       case SLANG_CHS:
00695         for (n = 0; n < na; n++) b[n] = (GENERIC_TYPE) -(a[n]);
00696         break;
00697 
00698       case SLANG_NOT:
00699         cb = (char *) bp;
00700         for (n = 0; n < na; n++) cb[n] = (a[n] == 0);
00701         break;
00702 
00703 #ifdef GENERIC_BIT_OPERATIONS
00704       case SLANG_BNOT:
00705         for (n = 0; n < na; n++) b[n] = ~(a[n]);
00706         break;
00707 #endif
00708       case SLANG_ISPOS:
00709         cb = (char *) bp;
00710         for (n = 0; n < na; n++) cb[n] = (a[n] > 0);
00711         break;
00712       case SLANG_ISNEG:
00713         cb = (char *) bp;
00714 #ifdef GENERIC_TYPE_IS_UNSIGNED
00715         for (n = 0; n < na; n++) cb[n] = 0;
00716 #else
00717         for (n = 0; n < na; n++) cb[n] = (a[n] < 0);
00718 #endif
00719         break;
00720       case SLANG_ISNONNEG:
00721         cb = (char *) bp;
00722 #ifdef GENERIC_TYPE_IS_UNSIGNED
00723         for (n = 0; n < na; n++) cb[n] = 1;
00724 #else
00725         for (n = 0; n < na; n++) cb[n] = (a[n] >= 0);
00726 #endif
00727         break;
00728      }
00729 
00730    return 1;
00731 }
00732 #endif                                 /* GENERIC_UNARY_FUNCTION */
00733 
00734 
00735 #ifdef SCALAR_BINARY_FUNCTION
00736 
00737 static int SCALAR_BINARY_FUNCTION (GENERIC_TYPE a, GENERIC_TYPE b, int op)
00738 {
00739    switch (op)
00740      {
00741       default:
00742         return 1;
00743 #if SLANG_HAS_FLOAT
00744 #ifdef POW_FUNCTION
00745       case SLANG_POW:
00746         return PUSH_POW_OBJ_FUN(POW_FUNCTION(a, b));
00747 #endif
00748 #endif
00749       case SLANG_PLUS:
00750         return PUSH_SCALAR_OBJ_FUN (a + b);
00751       case SLANG_MINUS:
00752         return PUSH_SCALAR_OBJ_FUN (a - b);
00753       case SLANG_TIMES:
00754         return PUSH_SCALAR_OBJ_FUN (a * b);
00755       case SLANG_DIVIDE:
00756 #if TRAP_DIV_ZERO
00757         if (b == 0)
00758           {
00759              SLang_set_error (SL_DIVIDE_ERROR);
00760              return -1;
00761           }
00762 #endif
00763         return PUSH_SCALAR_OBJ_FUN (a / b);
00764       case SLANG_MOD:
00765 #if TRAP_DIV_ZERO
00766         if (b == 0)
00767           {
00768              SLang_set_error (SL_DIVIDE_ERROR);
00769              return -1;
00770           }
00771 #endif
00772         return PUSH_SCALAR_OBJ_FUN (MOD_FUNCTION(a,b));
00773 #ifdef GENERIC_BIT_OPERATIONS
00774       case SLANG_BAND:
00775         return PUSH_SCALAR_OBJ_FUN (a & b);
00776       case SLANG_BXOR:
00777         return PUSH_SCALAR_OBJ_FUN (a ^ b);
00778       case SLANG_BOR:
00779         return PUSH_SCALAR_OBJ_FUN (a | b);
00780       case SLANG_SHL:
00781         return PUSH_SCALAR_OBJ_FUN (a << b);
00782       case SLANG_SHR:
00783         return PUSH_SCALAR_OBJ_FUN (a >> b);
00784 #endif
00785       case SLANG_GT: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a > b));
00786       case SLANG_LT: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a < b));
00787       case SLANG_GE: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a >= b));
00788       case SLANG_LE: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a <= b));
00789       case SLANG_EQ: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a == b));
00790       case SLANG_NE: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a != b));
00791       case SLANG_OR: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a || b));
00792       case SLANG_AND: return SLclass_push_char_obj (SLANG_CHAR_TYPE, (char)(a && b));
00793      }
00794 }
00795 
00796 #endif                                 /* SCALAR_BINARY_FUNCTION */
00797 
00798 #ifdef CMP_FUNCTION
00799 static int CMP_FUNCTION (SLtype unused, VOID_STAR a, VOID_STAR b, int *c)
00800 {
00801    GENERIC_TYPE x, y;
00802 
00803    (void) unused;
00804    x = *(GENERIC_TYPE *) a;
00805    y = *(GENERIC_TYPE *) b;
00806    
00807    if (x > y) *c = 1;
00808    else if (x == y) *c = 0;
00809    else *c = -1;
00810    
00811    return 0;
00812 }
00813 #endif
00814 
00815 #undef CMP_FUNCTION
00816 #undef SCALAR_BINARY_FUNCTION
00817 #undef PUSH_POW_OBJ_FUN
00818 #undef PUSH_SCALAR_OBJ_FUN
00819 #undef GENERIC_BINARY_FUNCTION
00820 #undef GENERIC_UNARY_FUNCTION
00821 #undef GENERIC_BIT_OPERATIONS
00822 #undef GENERIC_TYPE
00823 #undef POW_FUNCTION
00824 #undef POW_RESULT_TYPE
00825 #undef MOD_FUNCTION
00826 #undef ABS_FUNCTION
00827 #undef SIGN_FUNCTION
00828 #undef GENERIC_TYPE_IS_UNSIGNED
00829 #undef GENERIC_ARITH_UNARY_FUNCTION
00830 #undef TRAP_DIV_ZERO
slarith.inc
