Open64 (mfef90, whirl2f, and IR tools)  TAG: version-openad; SVN changeset: 916
math.c
Go to the documentation of this file.
00001 /*
00002 
00003   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00004 
00005   This program is free software; you can redistribute it and/or modify it
00006   under the terms of version 2 of the GNU General Public License as
00007   published by the Free Software Foundation.
00008 
00009   This program is distributed in the hope that it would be useful, but
00010   WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00012 
00013   Further, this software is distributed without any warranty that it is
00014   free of the rightful claim of any third person regarding infringement 
00015   or the like.  Any license provided herein, whether implied or 
00016   otherwise, applies only to this software file.  Patent licenses, if 
00017   any, provided herein do not apply to combinations of this program with 
00018   other software, or any other product whatsoever.  
00019 
00020   You should have received a copy of the GNU General Public License along
00021   with this program; if not, write the Free Software Foundation, Inc., 59
00022   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00023 
00024   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00025   Mountain View, CA 94043, or:
00026 
00027   http://www.sgi.com
00028 
00029   For further information regarding this notice, see:
00030 
00031   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00032 
00033 */
00034 
00035 
00036 /* High-level interface for basic math operations (+,-,*,/,%), as well
00037  * as implementation code for integer and pointer functions.
00038  */
00039 
00040 #include "arith.internal.h"
00041 
00042 
00043 /* Integer adder */
00044 int
00045 ar_add_integer
00046                 (ar_data *result, const AR_TYPE *resulttype,
00047    const ar_data *opnd1,  const AR_TYPE *opnd1type,
00048    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
00049 
00050         int status;
00051         int carry, overflow;
00052         long partialsum;
00053         int opnd1sign, opnd2sign;
00054 
00055         switch (AR_INT_SIZE (*opnd1type)) {
00056         case AR_INT_SIZE_8:
00057                 opnd1sign = INT8_SIGN(opnd1) != 0;
00058                 opnd2sign = INT8_SIGN(opnd2) != 0;
00059 
00060                 partialsum = (long)opnd1->ar_i8.part5 + opnd2->ar_i8.part5;
00061                 result->ar_i8.part5 = partialsum & 0xFF;
00062                 carry = partialsum >> 8;
00063                 ZERO_INT8_UPPER(result);
00064 
00065                 if (AR_SIGNEDNESS (*opnd1type) == AR_UNSIGNED)
00066                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00067                 else if ((opnd1sign == opnd2sign) &&
00068                          (opnd1sign != (INT8_SIGN(result) != 0)))
00069                         /*
00070                          * If the operands have the same sign, and the result
00071                          * sign is different, signal overflow.
00072                          */
00073                         status = AR_STAT_OVERFLOW;
00074                 else
00075                         status = AR_STAT_OK;
00076 
00077                 /* Inlined from AR_status: */
00078                 if (IS_INT8_ZERO(result))
00079                         status |= AR_STAT_ZERO;
00080                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
00081                          INT8_SIGN(result))
00082                         status |= AR_STAT_NEGATIVE;
00083                 break;
00084 
00085         case AR_INT_SIZE_16:
00086                 opnd1sign = INT16_SIGN(opnd1) != 0;
00087                 opnd2sign = INT16_SIGN(opnd2) != 0;
00088 
00089                 partialsum = (long)opnd1->ar_i64.part4 + opnd2->ar_i64.part4;
00090                 result->ar_i64.part4 = partialsum & 0xFFFF;
00091                 carry = partialsum >> 16;
00092                 ZERO_INT16_UPPER(result);
00093 
00094                 if (AR_SIGNEDNESS (*opnd1type) == AR_UNSIGNED)
00095                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00096                 else if ((opnd1sign == opnd2sign) &&
00097                          (opnd1sign != (INT16_SIGN(result) != 0)))
00098                         /*
00099                          * If the operands have the same sign, and the result
00100                          * sign is different, signal overflow.
00101                          */
00102                         status = AR_STAT_OVERFLOW;
00103                 else
00104                         status = AR_STAT_OK;
00105 
00106                 /* Inlined from AR_status: */
00107                 if (IS_INT16_ZERO(result))
00108                         status |= AR_STAT_ZERO;
00109                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
00110                          INT16_SIGN(result))
00111                         status |= AR_STAT_NEGATIVE;
00112                 break;
00113 
00114         case AR_INT_SIZE_32:
00115                 opnd1sign = INT32_SIGN(opnd1) != 0;
00116                 opnd2sign = INT32_SIGN(opnd2) != 0;
00117 
00118                 partialsum = (long)opnd1->ar_i64.part4 + opnd2->ar_i64.part4;
00119                 result->ar_i64.part4 = partialsum & 0xFFFF;
00120                 carry = partialsum >> 16;
00121 
00122                 partialsum = (long)opnd1->ar_i64.part3 + opnd2->ar_i64.part3 +
00123                              carry;
00124                 result->ar_i64.part3 = partialsum & 0xFFFF;
00125                 carry = partialsum >> 16;
00126                 ZERO_INT32_UPPER(result);
00127 
00128                 if (AR_SIGNEDNESS (*opnd1type) == AR_UNSIGNED)
00129                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00130                 else if ((opnd1sign == opnd2sign) &&
00131                          (opnd1sign != (INT32_SIGN(result) != 0)))
00132                         /*
00133                          * If the operands have the same sign, and the result
00134                          * sign is different, signal overflow.
00135                          */
00136                         status = AR_STAT_OVERFLOW;
00137                 else
00138                         status = AR_STAT_OK;
00139 
00140                 /* Inlined from AR_status: */
00141                 if (IS_INT32_ZERO(result))
00142                         status |= AR_STAT_ZERO;
00143                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
00144                          INT32_SIGN(result))
00145                         status |= AR_STAT_NEGATIVE;
00146                 break;
00147 
00148         case AR_INT_SIZE_46:
00149         case AR_INT_SIZE_64:
00150                 opnd1sign = INT64_SIGN(opnd1) != 0;
00151                 opnd2sign = INT64_SIGN(opnd2) != 0;
00152 
00153                 partialsum = (long)opnd1->ar_i64.part4 + opnd2->ar_i64.part4;
00154                 result->ar_i64.part4 = partialsum & 0xFFFF;
00155                 carry = partialsum >> 16;
00156 
00157                 partialsum = (long)opnd1->ar_i64.part3 + opnd2->ar_i64.part3 +
00158                              carry;
00159                 result->ar_i64.part3 = partialsum & 0xFFFF;
00160                 carry = partialsum >> 16;
00161 
00162                 partialsum = (long)opnd1->ar_i64.part2 + opnd2->ar_i64.part2 +
00163                              carry;
00164                 result->ar_i64.part2 = partialsum & 0xFFFF;
00165                 carry = partialsum >> 16;
00166 
00167                 partialsum = (long)opnd1->ar_i64.part1 + opnd2->ar_i64.part1 +
00168                              carry;
00169                 result->ar_i64.part1 = partialsum & 0xFFFF;
00170                 carry = partialsum >> 16;
00171 
00172                 if (AR_SIGNEDNESS (*opnd1type) == AR_UNSIGNED)
00173                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00174                 else if ((opnd1sign == opnd2sign) &&
00175                          (opnd1sign != (INT64_SIGN(result) != 0)))
00176                         /*
00177                          * If the operands have the same sign, and the result
00178                          * sign is different, signal overflow.
00179                          */
00180                         status = AR_STAT_OVERFLOW;
00181                 else
00182                         status = AR_STAT_OK;
00183 
00184                 /* Inlined from AR_status: */
00185                 if (IS_INT64_ZERO(result))
00186                         status |= AR_STAT_ZERO;
00187                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
00188                          INT64_SIGN(result))
00189                         status |= AR_STAT_NEGATIVE;
00190                 break;
00191 
00192         default:
00193                 return (AR_STAT_INVALID_TYPE);
00194         }
00195 
00196         return status;
00197 }
00198 
00199 /* Integer subtraction */
00200 int
00201 ar_subtract_integer
00202                 (ar_data *result, const AR_TYPE *resulttype, int *flags,
00203    const ar_data *opnd1,  const AR_TYPE *opnd1type,
00204    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
00205 
00206         int status;
00207         long sign, zero, overflow, carry;
00208         long partialdiff;
00209         int opnd1sign, opnd2sign;
00210 
00211         if (*resulttype != *opnd1type ||
00212             *resulttype != *opnd2type ||
00213             AR_CLASS (*resulttype) != AR_CLASS_INT)
00214                 return AR_STAT_INVALID_TYPE;
00215 
00216         switch (AR_INT_SIZE (*opnd1type)) {
00217         case AR_INT_SIZE_8:
00218                 opnd1sign = INT8_SIGN(opnd1) != 0;
00219                 opnd2sign = INT8_SIGN(opnd2) != 0;
00220 
00221                 partialdiff = (long) opnd1->ar_i8.part5 - opnd2->ar_i8.part5;
00222                 result->ar_i8.part5 = partialdiff & 0xFFFF;
00223                 carry = partialdiff < 0;
00224                 ZERO_INT8_UPPER(result);
00225 
00226                 /* If the operands differ in sign, and the result sign differs
00227                  * from the first operand's, signal overflow.
00228                  */
00229                 overflow = ((opnd1sign != opnd2sign) &&
00230                             (opnd1sign != (INT8_SIGN(result) != 0)));
00231                 zero = IS_INT8_ZERO(result);
00232                 sign = !!INT8_SIGN(result);
00233 
00234                 /* Return the flags to the caller if requested as SZVC bits. */
00235                 if (flags)
00236                         *flags = (sign << 3) | (zero << 2) | (overflow << 1) |
00237                                  carry;
00238 
00239                 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED)
00240                         status = overflow ? AR_STAT_OVERFLOW : AR_STAT_OK;
00241                 else
00242                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00243                 break;
00244 
00245         case AR_INT_SIZE_16:
00246                 opnd1sign = INT16_SIGN(opnd1) != 0;
00247                 opnd2sign = INT16_SIGN(opnd2) != 0;
00248 
00249                 partialdiff = (long) opnd1->ar_i64.part4 - opnd2->ar_i64.part4;
00250                 result->ar_i64.part4 = partialdiff & 0xFFFF;
00251                 carry = partialdiff < 0;
00252                 ZERO_INT16_UPPER(result);
00253 
00254                 /* If the operands differ in sign, and the result sign differs
00255                  * from the first operand's, signal overflow.
00256                  */
00257                 overflow = ((opnd1sign != opnd2sign) &&
00258                             (opnd1sign != (INT16_SIGN(result) != 0)));
00259                 zero = IS_INT16_ZERO(result);
00260                 sign = !!INT16_SIGN(result);
00261 
00262                 /* Return the flags to the caller if requested as SZVC bits. */
00263                 if (flags)
00264                         *flags = (sign << 3) | (zero << 2) | (overflow << 1) |
00265                                  carry;
00266 
00267                 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED)
00268                         status = overflow ? AR_STAT_OVERFLOW : AR_STAT_OK;
00269                 else
00270                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00271                 break;
00272 
00273         case AR_INT_SIZE_32:
00274                 opnd1sign = INT32_SIGN(opnd1) != 0;
00275                 opnd2sign = INT32_SIGN(opnd2) != 0;
00276 
00277                 partialdiff = (long) opnd1->ar_i64.part4 - opnd2->ar_i64.part4;
00278                 result->ar_i64.part4 = partialdiff & 0xFFFF;
00279                 carry = partialdiff < 0;
00280 
00281                 partialdiff = (long) opnd1->ar_i64.part3 - opnd2->ar_i64.part3 -
00282                               carry;
00283                 result->ar_i64.part3 = partialdiff & 0xFFFF;
00284                 carry = partialdiff < 0;
00285                 ZERO_INT32_UPPER(result);
00286 
00287                 /* If the operands differ in sign, and the result sign differs
00288                  * from the first operand's, signal overflow.
00289                  */
00290                 overflow = ((opnd1sign != opnd2sign) &&
00291                             (opnd1sign != (INT32_SIGN(result) != 0)));
00292                 zero = IS_INT32_ZERO(result);
00293                 sign = !!INT32_SIGN(result);
00294 
00295                 /* Return the flags to the caller if requested as SZVC bits. */
00296                 if (flags)
00297                         *flags = (sign << 3) | (zero << 2) | (overflow << 1) |
00298                                  carry;
00299 
00300                 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED)
00301                         status = overflow ? AR_STAT_OVERFLOW : AR_STAT_OK;
00302                 else
00303                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00304                 break;
00305 
00306         case AR_INT_SIZE_46:
00307         case AR_INT_SIZE_64:
00308                 opnd1sign = INT64_SIGN(opnd1) != 0;
00309                 opnd2sign = INT64_SIGN(opnd2) != 0;
00310 
00311                 partialdiff = (long) opnd1->ar_i64.part4 - opnd2->ar_i64.part4;
00312                 result->ar_i64.part4 = partialdiff & 0xFFFF;
00313                 carry = partialdiff < 0;
00314 
00315                 partialdiff = (long) opnd1->ar_i64.part3 - opnd2->ar_i64.part3 -
00316                               carry;
00317                 result->ar_i64.part3 = partialdiff & 0xFFFF;
00318                 carry = partialdiff < 0;
00319 
00320                 partialdiff = (long) opnd1->ar_i64.part2 - opnd2->ar_i64.part2 -
00321                               carry;
00322                 result->ar_i64.part2 = partialdiff & 0xFFFF;
00323                 carry = partialdiff < 0;
00324 
00325                 partialdiff = (long) opnd1->ar_i64.part1 - opnd2->ar_i64.part1 -
00326                               carry;
00327                 result->ar_i64.part1 = partialdiff & 0xFFFF;
00328                 carry = partialdiff < 0;
00329 
00330                 /* If the operands differ in sign, and the result sign differs
00331                  * from the first operand's, signal overflow.
00332                  */
00333                 overflow = ((opnd1sign != opnd2sign) &&
00334                             (opnd1sign != (INT64_SIGN(result) != 0)));
00335                 zero = IS_INT64_ZERO(result);
00336                 sign = !!INT64_SIGN(result);
00337 
00338                 /* Return the flags to the caller if requested as SZVC bits. */
00339                 if (flags)
00340                         *flags = (sign << 3) | (zero << 2) | (overflow << 1) |
00341                                  carry;
00342 
00343                 if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED)
00344                         status = overflow ? AR_STAT_OVERFLOW : AR_STAT_OK;
00345                 else
00346                         status = carry ? AR_STAT_OVERFLOW : AR_STAT_OK;
00347                 break;
00348 
00349         default:
00350                 return (AR_STAT_INVALID_TYPE);
00351         }
00352 
00353         return status | AR_status ((AR_DATA*)result, resulttype);
00354 }
00355 
00356 
00357 /* Pointer + integer computation */
00358 static
00359 int
00360 ar_add_pointer
00361                 (ar_data *result, const AR_TYPE *resulttype,
00362    const ar_data *opnd1,  const AR_TYPE *opnd1type,
00363    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
00364 
00365         ar_data temp, ptropnd, intopnd;
00366         AR_TYPE temptype, ptropndtype, intopndtype;
00367         AR_TYPE shifttype = AR_Int_64_U;
00368 
00369         if (AR_CLASS (*opnd1type) == AR_CLASS_POINTER) {
00370                 ptropnd = *opnd1;
00371                 intopnd = *opnd2;
00372                 ptropndtype = *opnd1type;
00373                 intopndtype = *opnd2type;
00374         } else {
00375                 ptropnd = *opnd2;
00376                 intopnd = *opnd1;
00377                 ptropndtype = *opnd2type;
00378                 intopndtype = *opnd1type;
00379         }
00380 
00381         if (*resulttype != ptropndtype ||
00382             AR_CLASS (intopndtype) != AR_CLASS_INT ||
00383             AR_POINTER_FORMAT (ptropndtype) == AR_POINTER_FCTN)
00384                 return AR_STAT_INVALID_TYPE;
00385 
00386         if (AR_POINTER_FORMAT (ptropndtype) == AR_POINTER_CHAR) {
00387                 /* Turn C char pointer into byte address */
00388                 ar_dblshift (&temp, &shifttype, &ptropnd, &ptropnd, 128-3);
00389                 ptropnd = temp;
00390         }
00391 
00392         ar_add_integer (result, &intopndtype,
00393                         &ptropnd, &intopndtype,
00394                         &intopnd, &intopndtype);
00395 
00396         if (AR_POINTER_FORMAT (ptropndtype) == AR_POINTER_CHAR) {
00397                 /* Restore byte address into C char pointer */
00398                 ar_dblshift (&temp, &shifttype, result, result, 3);
00399                 result->ar_i64 = temp.ar_i64;
00400         }
00401 
00402         ar_clear_unused_bits (result, resulttype);
00403 
00404         return AR_STAT_OK;
00405 }
00406 
00407 
00408 /* Pointer - integer, pointer - pointer computation */
00409 static
00410 int
00411 ar_subtract_pointer
00412                 (ar_data *result, const AR_TYPE *resulttype,
00413    const ar_data *opnd1,  const AR_TYPE *opnd1type,
00414    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
00415 
00416         ar_data temp1, temp2;
00417         AR_TYPE temp1type, temp2type;
00418         AR_TYPE shifttype = AR_Int_64_U;
00419 
00420         if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_FCTN)
00421                 return AR_STAT_INVALID_TYPE;
00422 
00423         if (AR_CLASS (*opnd2type) == AR_CLASS_POINTER) {
00424                 /* pointer difference */
00425                 if (*opnd1type != *opnd2type ||
00426                     AR_CLASS (*resulttype) != AR_CLASS_INT ||
00427                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_8 &&
00428                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_16 &&
00429                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_32 &&
00430                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_46 &&
00431                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_64)
00432                         return AR_STAT_INVALID_TYPE;
00433                 if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_CHAR) {
00434                         /* Convert C char pointers to byte addresses */
00435                         ar_dblshift (&temp1, &shifttype, opnd1, opnd1, 128-3);
00436                         ar_dblshift (&temp2, &shifttype, opnd2, opnd2, 128-3);
00437                 } else {
00438                         temp1 = *opnd1;
00439                         temp2 = *opnd2;
00440                 }
00441                 return ar_subtract_integer (result, resulttype, (int *)0,
00442                                             &temp1, resulttype,
00443                                             &temp2, resulttype);
00444         }
00445 
00446         if (AR_CLASS (*opnd2type) == AR_CLASS_INT) {
00447                 if (*resulttype != *opnd1type ||
00448                     AR_INT_SIZE (*opnd2type) != AR_INT_SIZE_8 &&
00449                     AR_INT_SIZE (*opnd2type) != AR_INT_SIZE_16 &&
00450                     AR_INT_SIZE (*opnd2type) != AR_INT_SIZE_32 &&
00451                     AR_INT_SIZE (*opnd2type) != AR_INT_SIZE_46 &&
00452                     AR_INT_SIZE (*opnd2type) != AR_INT_SIZE_64)
00453                         return AR_STAT_INVALID_TYPE;
00454                 if (AR_POINTER_FORMAT (*resulttype) == AR_POINTER_CHAR)
00455                         ar_dblshift (&temp1, &shifttype, opnd1, opnd1, 128-3);
00456                 else
00457                         temp1 = *opnd1;
00458                 ar_subtract_integer (result, opnd2type, (int *)0,
00459                                      &temp1, opnd2type,
00460                                      opnd2, opnd2type);
00461                 if (AR_POINTER_FORMAT (*resulttype) == AR_POINTER_CHAR) {
00462                         ar_dblshift (&temp1, &shifttype, result, result, 3);
00463                         result->ar_i64 = temp1.ar_i64;
00464                 }
00465                 ar_clear_unused_bits (result, resulttype);
00466                 return AR_STAT_OK;
00467         }
00468 
00469         return AR_STAT_INVALID_TYPE;
00470 }
00471 
00472 
00473 /* General dispatch routine for addition */
00474 int
00475 AR_add  (AR_DATA *res, const AR_TYPE *resulttype,
00476    const AR_DATA *op1, const AR_TYPE *opnd1type,
00477    const AR_DATA *op2, const AR_TYPE *opnd2type) {
00478 
00479         ar_data* result = (ar_data*)res;
00480         ar_data* opnd1  = (ar_data*)op1;
00481         ar_data* opnd2  = (ar_data*)op2;
00482 
00483         int status = AR_STAT_OK, restat, imstat;
00484 
00485         ar_data tmp1, tmp2;
00486 
00487         if (AR_CLASS (*opnd1type) == AR_CLASS_POINTER ||
00488             AR_CLASS (*opnd2type) == AR_CLASS_POINTER)
00489                 return ar_add_pointer (result, resulttype,
00490                                        opnd1, opnd1type,
00491                                        opnd2, opnd2type);
00492 
00493         if (AR_CLASS (*opnd1type) == AR_CLASS_INT) {
00494                 if (*resulttype != *opnd1type ||
00495                     *resulttype != *opnd2type ||
00496                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_8 &&
00497                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_16 &&
00498                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_32 &&
00499                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_46 &&
00500                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_64)
00501                         return AR_STAT_INVALID_TYPE;
00502                 status = ar_add_integer (result, resulttype,
00503                                          opnd1, opnd1type,
00504                                          opnd2, opnd2type);
00505                 if (AR_SIGNEDNESS (*resulttype) == AR_UNSIGNED)
00506                         status &= ~AR_STAT_OVERFLOW;
00507                 return status;
00508         }
00509 
00510         if (AR_CLASS (*opnd1type) == AR_CLASS_FLOAT) {
00511 
00512                 if (*resulttype != *opnd1type || *resulttype != *opnd2type)
00513                         return AR_STAT_INVALID_TYPE;
00514 
00515                 switch (*resulttype) {
00516                 case AR_Float_Cray1_64:
00517                 case AR_Float_Cray1_64_F:
00518                         status = ar_cfadd64 (&result->ar_f64,
00519                                              &opnd1->ar_f64, &opnd2->ar_f64);
00520                         if (ar_state_register.ar_truncate_bits > 0)
00521                                 ar_CRAY_64_trunc(&result->ar_f64);
00522                         return status;
00523 
00524                 case AR_Float_Cray1_128:
00525                         return ar_cfadd128 (&result->ar_f128,
00526                                             &opnd1->ar_f128, &opnd2->ar_f128);
00527                 case AR_Float_IEEE_NR_32:
00528                 case AR_Float_IEEE_ZE_32:
00529                 case AR_Float_IEEE_UP_32:
00530                 case AR_Float_IEEE_DN_32:
00531                         return ar_ifadd32 (&result->ar_ieee32,
00532                                            &opnd1->ar_ieee32, &opnd2->ar_ieee32,
00533                                            ROUND_MODE (*resulttype));
00534                 case AR_Float_IEEE_NR_64:
00535                 case AR_Float_IEEE_ZE_64:
00536                 case AR_Float_IEEE_UP_64:
00537                 case AR_Float_IEEE_DN_64:
00538                         return ar_ifadd64 (&result->ar_ieee64,
00539                                            &opnd1->ar_ieee64, &opnd2->ar_ieee64,
00540                                            ROUND_MODE (*resulttype));
00541                 case AR_Float_IEEE_NR_128:
00542                 case AR_Float_IEEE_ZE_128:
00543                 case AR_Float_IEEE_UP_128:
00544                 case AR_Float_IEEE_DN_128:
00545                         return ar_ifadd128 (&result->ar_ieee128,
00546                                            &opnd1->ar_ieee128, &opnd2->ar_ieee128,
00547                                            ROUND_MODE (*resulttype));
00548                 case AR_Complex_Cray1_64:
00549                 case AR_Complex_Cray1_64_F:
00550                         restat = ar_cfadd64 (&result->ar_cplx_f64.real,
00551                                              &opnd1->ar_cplx_f64.real,
00552                                              &opnd2->ar_cplx_f64.real);
00553                         if (ar_state_register.ar_truncate_bits > 0)
00554                                 ar_CRAY_64_trunc(&result->ar_cplx_f64.real);
00555                         imstat = ar_cfadd64 (&result->ar_cplx_f64.imag,
00556                                              &opnd1->ar_cplx_f64.imag,
00557                                              &opnd2->ar_cplx_f64.imag);
00558                         if (ar_state_register.ar_truncate_bits > 0)
00559                                 ar_CRAY_64_trunc(&result->ar_cplx_f64.imag);
00560                         status = (restat | imstat) &
00561                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00562                         status |= restat & imstat & AR_STAT_ZERO;
00563                         return status;
00564                 case AR_Complex_Cray1_128:
00565                         restat = ar_cfadd128 (&result->ar_cplx_f128.real,
00566                                               &opnd1->ar_cplx_f128.real,
00567                                               &opnd2->ar_cplx_f128.real);
00568                         imstat = ar_cfadd128 (&result->ar_cplx_f128.imag,
00569                                               &opnd1->ar_cplx_f128.imag,
00570                                               &opnd2->ar_cplx_f128.imag);
00571                         status = (restat | imstat) &
00572                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00573                         status |= restat & imstat & AR_STAT_ZERO;
00574                         return status;
00575                 case AR_Complex_IEEE_NR_32:
00576                 case AR_Complex_IEEE_ZE_32:
00577                 case AR_Complex_IEEE_UP_32:
00578                 case AR_Complex_IEEE_DN_32:
00579                 {
00580                         AR_IEEE_32 o1, o2, rslt;
00581 
00582                         CPLX32_REAL_TO_IEEE32(o1, opnd1->ar_cplx_ieee32);
00583                         CPLX32_REAL_TO_IEEE32(o2, opnd2->ar_cplx_ieee32);
00584                         restat = ar_ifadd32 (&rslt, &o1, &o2,
00585                                              ROUND_MODE (*resulttype));
00586                         IEEE32_TO_CPLX32_REAL(result->ar_cplx_ieee32, rslt);
00587 
00588                         CPLX32_IMAG_TO_IEEE32(o1, opnd1->ar_cplx_ieee32);
00589                         CPLX32_IMAG_TO_IEEE32(o2, opnd2->ar_cplx_ieee32);
00590                         imstat = ar_ifadd32 (&rslt, &o1, &o2,
00591                                              ROUND_MODE (*resulttype));
00592                         IEEE32_TO_CPLX32_IMAG(result->ar_cplx_ieee32, rslt);
00593 
00594                         status = (restat | imstat) &
00595                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00596                         status |= restat & imstat & AR_STAT_ZERO;
00597                         return status;
00598                 }
00599                 case AR_Complex_IEEE_NR_64:
00600                 case AR_Complex_IEEE_ZE_64:
00601                 case AR_Complex_IEEE_UP_64:
00602                 case AR_Complex_IEEE_DN_64:
00603                         restat = ar_ifadd64 (&result->ar_cplx_ieee64.real,
00604                                              &opnd1->ar_cplx_ieee64.real,
00605                                              &opnd2->ar_cplx_ieee64.real,
00606                                              ROUND_MODE (*resulttype));
00607                         imstat = ar_ifadd64 (&result->ar_cplx_ieee64.imag,
00608                                              &opnd1->ar_cplx_ieee64.imag,
00609                                              &opnd2->ar_cplx_ieee64.imag,
00610                                              ROUND_MODE (*resulttype));
00611                         status = (restat | imstat) &
00612                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00613                         status |= restat & imstat & AR_STAT_ZERO;
00614                         return status;
00615                 case AR_Complex_IEEE_NR_128:
00616                 case AR_Complex_IEEE_ZE_128:
00617                 case AR_Complex_IEEE_UP_128:
00618                 case AR_Complex_IEEE_DN_128:
00619                         restat = ar_ifadd128 (&result->ar_cplx_ieee128.real,
00620                                              &opnd1->ar_cplx_ieee128.real,
00621                                              &opnd2->ar_cplx_ieee128.real,
00622                                              ROUND_MODE (*resulttype));
00623                         imstat = ar_ifadd128 (&result->ar_cplx_ieee128.imag,
00624                                              &opnd1->ar_cplx_ieee128.imag,
00625                                              &opnd2->ar_cplx_ieee128.imag,
00626                                              ROUND_MODE (*resulttype));
00627                         status = (restat | imstat) &
00628                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00629                         status |= restat & imstat & AR_STAT_ZERO;
00630                         return status;
00631                 default:
00632                         return AR_STAT_INVALID_TYPE;
00633                 }
00634         }
00635 
00636         return AR_STAT_INVALID_TYPE;
00637 }
00638 
00639 
00640 /* General dispatch routine for subtraction */
00641 int
00642 AR_subtract
00643                 (AR_DATA *res, const AR_TYPE *resulttype,
00644    const AR_DATA *op1, const AR_TYPE *opnd1type,
00645    const AR_DATA *op2, const AR_TYPE *opnd2type) {
00646 
00647         ar_data* result = (ar_data*)res;
00648         ar_data* opnd1  = (ar_data*)op1;
00649         ar_data* opnd2  = (ar_data*)op2;
00650 
00651         int status, restat, imstat;
00652 
00653         ar_data tmp1, tmp2;
00654 
00655         if (AR_CLASS (*opnd1type) == AR_CLASS_POINTER)
00656                 return ar_subtract_pointer (result, resulttype,
00657                                             opnd1, opnd1type,
00658                                             opnd2, opnd2type);
00659 
00660         if (AR_CLASS (*opnd1type) == AR_CLASS_INT) {
00661                 status = ar_subtract_integer (result, resulttype, (int *)0,
00662                                               opnd1, opnd1type,
00663                                               opnd2, opnd2type);
00664                 if (AR_SIGNEDNESS (*resulttype) == AR_UNSIGNED)
00665                         status &= ~AR_STAT_OVERFLOW;
00666                 return status;
00667         }
00668 
00669         if (AR_CLASS (*opnd1type) == AR_CLASS_FLOAT) {
00670                 if (*resulttype != *opnd1type || *resulttype != *opnd2type)
00671                         return AR_STAT_INVALID_TYPE;
00672                 switch (*resulttype) {
00673                 case AR_Float_Cray1_64:
00674                 case AR_Float_Cray1_64_F:
00675                         status = ar_cfsub64 (&result->ar_f64,
00676                                              &opnd1->ar_f64, &opnd2->ar_f64);
00677                         if (ar_state_register.ar_truncate_bits > 0)
00678                                 ar_CRAY_64_trunc(&result->ar_f64);
00679                         return status;
00680 
00681                 case AR_Float_Cray1_128:
00682                         return ar_cfsub128 (&result->ar_f128,
00683                                             &opnd1->ar_f128, &opnd2->ar_f128);
00684                 case AR_Float_IEEE_NR_32:
00685                 case AR_Float_IEEE_ZE_32:
00686                 case AR_Float_IEEE_DN_32:
00687                 case AR_Float_IEEE_UP_32:
00688                         return ar_ifsub32 (&result->ar_ieee32,
00689                                            &opnd1->ar_ieee32, &opnd2->ar_ieee32,
00690                                            ROUND_MODE (*resulttype));
00691                 case AR_Float_IEEE_NR_64:
00692                 case AR_Float_IEEE_ZE_64:
00693                 case AR_Float_IEEE_DN_64:
00694                 case AR_Float_IEEE_UP_64:
00695                         return ar_ifsub64 (&result->ar_ieee64,
00696                                            &opnd1->ar_ieee64, &opnd2->ar_ieee64,
00697                                            ROUND_MODE (*resulttype));
00698                 case AR_Float_IEEE_NR_128:
00699                 case AR_Float_IEEE_ZE_128:
00700                 case AR_Float_IEEE_DN_128:
00701                 case AR_Float_IEEE_UP_128:
00702                         return ar_ifsub128 (&result->ar_ieee128,
00703                                            &opnd1->ar_ieee128, &opnd2->ar_ieee128,
00704                                            ROUND_MODE (*resulttype));
00705                 case AR_Complex_Cray1_64:
00706                 case AR_Complex_Cray1_64_F:
00707                         restat = ar_cfsub64 (&result->ar_cplx_f64.real,
00708                                              &opnd1->ar_cplx_f64.real,
00709                                              &opnd2->ar_cplx_f64.real);
00710                         if (ar_state_register.ar_truncate_bits > 0)
00711                                 ar_CRAY_64_trunc(&result->ar_cplx_f64.real);
00712                         imstat = ar_cfsub64 (&result->ar_cplx_f64.imag,
00713                                              &opnd1->ar_cplx_f64.imag,
00714                                              &opnd2->ar_cplx_f64.imag);
00715                         if (ar_state_register.ar_truncate_bits > 0)
00716                                 ar_CRAY_64_trunc(&result->ar_cplx_f64.imag);
00717                         status = (restat | imstat) &
00718                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00719                         status |= restat & imstat & AR_STAT_ZERO;
00720                         return status;
00721                 case AR_Complex_Cray1_128:
00722                         restat = ar_cfsub128 (&result->ar_cplx_f128.real,
00723                                              &opnd1->ar_cplx_f128.real,
00724                                              &opnd2->ar_cplx_f128.real);
00725                         imstat = ar_cfsub128 (&result->ar_cplx_f128.imag,
00726                                              &opnd1->ar_cplx_f128.imag,
00727                                              &opnd2->ar_cplx_f128.imag);
00728                         status = (restat | imstat) &
00729                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00730                         status |= restat & imstat & AR_STAT_ZERO;
00731                         return status;
00732                 case AR_Complex_IEEE_NR_32:
00733                 case AR_Complex_IEEE_ZE_32:
00734                 case AR_Complex_IEEE_UP_32:
00735                 case AR_Complex_IEEE_DN_32:
00736                 {
00737                         AR_IEEE_32 o1, o2, rslt;
00738 
00739                         CPLX32_REAL_TO_IEEE32(o1, opnd1->ar_cplx_ieee32);
00740                         CPLX32_REAL_TO_IEEE32(o2, opnd2->ar_cplx_ieee32);
00741                         restat = ar_ifsub32 (&rslt, &o1, &o2,
00742                                              ROUND_MODE (*resulttype));
00743                         IEEE32_TO_CPLX32_REAL(result->ar_cplx_ieee32, rslt);
00744 
00745                         CPLX32_IMAG_TO_IEEE32(o1, opnd1->ar_cplx_ieee32);
00746                         CPLX32_IMAG_TO_IEEE32(o2, opnd2->ar_cplx_ieee32);
00747                         imstat = ar_ifsub32 (&rslt, &o1, &o2,
00748                                              ROUND_MODE (*resulttype));
00749                         IEEE32_TO_CPLX32_IMAG(result->ar_cplx_ieee32, rslt);
00750 
00751                         status = (restat | imstat) &
00752                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00753                         status |= restat & imstat & AR_STAT_ZERO;
00754                         return status;
00755                 }
00756                 case AR_Complex_IEEE_NR_64:
00757                 case AR_Complex_IEEE_ZE_64:
00758                 case AR_Complex_IEEE_UP_64:
00759                 case AR_Complex_IEEE_DN_64:
00760                         restat = ar_ifsub64 (&result->ar_cplx_ieee64.real,
00761                                              &opnd1->ar_cplx_ieee64.real,
00762                                              &opnd2->ar_cplx_ieee64.real,
00763                                              ROUND_MODE (*resulttype));
00764                         imstat = ar_ifsub64 (&result->ar_cplx_ieee64.imag,
00765                                              &opnd1->ar_cplx_ieee64.imag,
00766                                              &opnd2->ar_cplx_ieee64.imag,
00767                                              ROUND_MODE (*resulttype));
00768                         status = (restat | imstat) &
00769                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00770                         status |= restat & imstat & AR_STAT_ZERO;
00771                         return status;
00772                 case AR_Complex_IEEE_NR_128:
00773                 case AR_Complex_IEEE_ZE_128:
00774                 case AR_Complex_IEEE_UP_128:
00775                 case AR_Complex_IEEE_DN_128:
00776                         restat = ar_ifsub128 (&result->ar_cplx_ieee128.real,
00777                                              &opnd1->ar_cplx_ieee128.real,
00778                                              &opnd2->ar_cplx_ieee128.real,
00779                                              ROUND_MODE (*resulttype));
00780                         imstat = ar_ifsub128 (&result->ar_cplx_ieee128.imag,
00781                                              &opnd1->ar_cplx_ieee128.imag,
00782                                              &opnd2->ar_cplx_ieee128.imag,
00783                                              ROUND_MODE (*resulttype));
00784                         status = (restat | imstat) &
00785                                  ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
00786                         status |= restat & imstat & AR_STAT_ZERO;
00787                         return status;
00788                 default:
00789                         return AR_STAT_INVALID_TYPE;
00790                 }
00791         }
00792 
00793         return AR_STAT_INVALID_TYPE;
00794 }
00795 
00796 
00797 /* Integer negation */
00798 int
00799 ar_negate_integer
00800                 (ar_data *result, const AR_TYPE *resulttype,
00801    const ar_data *opnd,   const AR_TYPE *opndtype) {
00802 
00803         ar_data temp, temp1;
00804         int status;
00805 
00806         if (AR_CLASS (*opndtype) != AR_CLASS_INT)
00807                 return AR_STAT_INVALID_TYPE;
00808             
00809         switch (AR_INT_SIZE (*opndtype)) {
00810         case AR_INT_SIZE_8:
00811                 /* Compute complement */
00812                 temp.ar_i8.part5 = 0xFF ^ opnd->ar_i8.part5;
00813 
00814                 /* Add one */
00815                 temp1.ar_i8.part5 = 1;
00816                 break;
00817 
00818         case AR_INT_SIZE_16:
00819                 /* Compute complement */
00820                 temp.ar_i64.part4 = 0xFFFF ^ opnd->ar_i64.part4;
00821 
00822                 /* Add one */
00823                 temp1.ar_i64.part4 = 1;
00824                 break;
00825 
00826         case AR_INT_SIZE_32:
00827                 /* Compute complement */
00828                 temp.ar_i64.part3 = 0xFFFF ^ opnd->ar_i64.part3;
00829                 temp.ar_i64.part4 = 0xFFFF ^ opnd->ar_i64.part4;
00830 
00831                 /* Add one */
00832                 temp1.ar_i64.part3 = 0;
00833                 temp1.ar_i64.part4 = 1;
00834                 break;
00835 
00836         case AR_INT_SIZE_46:
00837         case AR_INT_SIZE_64:
00838                 /* Compute complement */
00839                 temp.ar_i64.part1 = 0xFFFF ^ opnd->ar_i64.part1;
00840                 temp.ar_i64.part2 = 0xFFFF ^ opnd->ar_i64.part2;
00841                 temp.ar_i64.part3 = 0xFFFF ^ opnd->ar_i64.part3;
00842                 temp.ar_i64.part4 = 0xFFFF ^ opnd->ar_i64.part4;
00843 
00844                 /* Add one */
00845                 temp1.ar_i64.part1 = 0;
00846                 temp1.ar_i64.part2 = 0;
00847                 temp1.ar_i64.part3 = 0;
00848                 temp1.ar_i64.part4 = 1;
00849                 break;
00850 
00851         default:
00852                 return (AR_STAT_INVALID_TYPE);
00853         }
00854 
00855         status = ar_add_integer (result, resulttype,
00856                                  &temp, opndtype,
00857                                  &temp1, opndtype);
00858         if (AR_SIGNEDNESS (*resulttype) == AR_UNSIGNED)
00859                 status &= ~AR_STAT_OVERFLOW;
00860         else if((status&AR_STAT_OVERFLOW) && (status&AR_STAT_NEGATIVE)) {
00861                 switch (AR_INT_SIZE (*resulttype)) {
00862                 case AR_INT_SIZE_8:
00863                         if(result->ar_i8.part5 == 0x80)
00864                                 status = (status^AR_STAT_OVERFLOW) |
00865                                          AR_STAT_SEMIVALID;
00866                         break;
00867 
00868                 case AR_INT_SIZE_16:
00869                         if(result->ar_i64.part4 == 0x8000)
00870                                 status = (status^AR_STAT_OVERFLOW) |
00871                                          AR_STAT_SEMIVALID;
00872                         break;
00873 
00874                 case AR_INT_SIZE_32:
00875                         if(result->ar_i64.part3 == 0x8000 &&
00876                            result->ar_i64.part4 == 0)
00877                                 status = (status^AR_STAT_OVERFLOW) |
00878                                          AR_STAT_SEMIVALID;
00879                         break;
00880 
00881                 case AR_INT_SIZE_46:
00882                 case AR_INT_SIZE_64:
00883                         if (result->ar_i64.part1 == 0x8000 &&
00884                             result->ar_i64.part2 == 0 &&
00885                             result->ar_i64.part3 == 0 &&
00886                             result->ar_i64.part4 == 0)
00887                                 status = (status^AR_STAT_OVERFLOW) |
00888                                          AR_STAT_SEMIVALID;
00889                         break;
00890 
00891                 default:
00892                         return (AR_STAT_INVALID_TYPE);
00893                 }
00894         }
00895 
00896         return status;
00897 }
00898 
00899 
00900 /* Floating-point negation */
00901 int
00902 ar_negate_float
00903                 (ar_data *result, const AR_TYPE *resulttype,
00904    const ar_data *opnd,   const AR_TYPE *opndtype) {
00905 
00906         if (*resulttype != *opndtype ||
00907             AR_CLASS (*resulttype) != AR_CLASS_FLOAT)
00908                 return AR_STAT_INVALID_TYPE;
00909 
00910         if (AR_FLOAT_FORMAT (*resulttype) == AR_FLOAT_CRAY) {
00911                 if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64) {
00912                         result->ar_f64 = opnd->ar_f64;
00913                         if (result->ar_f64.expo |
00914                                 result->ar_f64.coeff0 | result->ar_f64.coeff1 |
00915                                 result->ar_f64.coeff2) {
00916                                 result->ar_f64.sign ^= 1;
00917                                 return AR_STAT_OK;
00918                         } else
00919                                 return AR_STAT_ZERO;
00920                 }
00921                 if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128) {
00922                         result->ar_f128 = opnd->ar_f128;
00923                         if (result->ar_f128.expo |
00924                             result->ar_f128.coeff0 | result->ar_f128.coeff1 |
00925                             result->ar_f128.coeff2 | result->ar_f128.coeff3 |
00926                             result->ar_f128.coeff4 | result->ar_f128.coeff5) {
00927                                 result->ar_f128.sign ^= 1;
00928                                 return AR_STAT_OK;
00929                         } else
00930                                 return AR_STAT_ZERO;
00931                 }
00932                 return AR_STAT_INVALID_TYPE;
00933         }
00934 
00935         /* Must be IEEE */
00936         if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_32) {
00937                 result->ar_ieee32 = opnd->ar_ieee32;
00938                 result->ar_ieee32.sign ^= 1;
00939                 return AR_status ((AR_DATA*)result, resulttype);
00940         }
00941 
00942         if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_64) {
00943                 result->ar_ieee64 = opnd->ar_ieee64;
00944                 result->ar_ieee64.sign ^= 1;
00945                 return AR_status ((AR_DATA*)result, resulttype);
00946         }
00947 
00948         if (AR_FLOAT_SIZE (*resulttype) == AR_FLOAT_128) {
00949                 if (HOST_IS_MIPS) {
00950                         result->ar_mips128 = opnd->ar_mips128;
00951                         result->ar_mips128.sign ^= 1;
00952                         result->ar_mips128.signl ^= 1;
00953                 }
00954                 else {
00955                         result->ar_ieee128 = opnd->ar_ieee128;
00956                         result->ar_ieee128.sign ^= 1;
00957                 }
00958                 return AR_status ((AR_DATA*)result, resulttype);
00959         }
00960 
00961         return AR_STAT_INVALID_TYPE;
00962 }
00963 
00964 
00965 static
00966 int
00967 ar_negate_complex
00968                 (ar_data *result, const AR_TYPE *resulttype,
00969    const ar_data *opnd,   const AR_TYPE *opndtype) {
00970 
00971         int status, restat, imstat;
00972         ar_data re, im, nre, nim;
00973         AR_TYPE reimtype, cplxtype;
00974 
00975         if (*resulttype != *opndtype ||
00976             AR_CLASS (*resulttype) != AR_CLASS_FLOAT ||
00977             AR_FLOAT_IS_COMPLEX (*resulttype) != AR_FLOAT_COMPLEX)
00978                 return AR_STAT_INVALID_TYPE;
00979 
00980         status = ar_decompose_complex (&re, &im, &reimtype, opnd, opndtype);
00981         status |= restat = ar_negate_float (&nre, &reimtype, &re, &reimtype);
00982         status |= imstat = ar_negate_float (&nim, &reimtype, &im, &reimtype);
00983         status |= ar_compose_complex (result, &cplxtype, &nre, &nim, &reimtype);
00984         status &= ~(AR_STAT_NEGATIVE | AR_STAT_ZERO);
00985         status |= restat & imstat & AR_STAT_ZERO;
00986         return status;
00987 }
00988 
00989 
00990 /* General dispatch routine for negation */
00991 int
00992 AR_negate
00993                 (AR_DATA *res, const AR_TYPE *resulttype,
00994    const AR_DATA *opd, const AR_TYPE *opndtype) {
00995 
00996         ar_data* result = (ar_data*)res;
00997         ar_data* opnd   = (ar_data*)opd;
00998 
00999         if (*resulttype != *opndtype)
01000                 return AR_STAT_INVALID_TYPE;
01001         if (AR_CLASS (*resulttype) == AR_CLASS_INT)
01002                 return ar_negate_integer (result, resulttype, opnd, opndtype);
01003         if (AR_CLASS (*resulttype) == AR_CLASS_FLOAT)
01004                 if (AR_FLOAT_IS_COMPLEX (*resulttype) == AR_FLOAT_COMPLEX)
01005                         return ar_negate_complex (result, resulttype, opnd, opndtype);
01006                 else
01007                         return ar_negate_float (result, resulttype, opnd, opndtype);
01008         return AR_STAT_INVALID_TYPE;
01009 }
01010 
01011 
01012 /* Integer multiplication */
01013 int
01014 ar_multiply_integer
01015                 (ar_data *result, const AR_TYPE *resulttype,
01016    const ar_data *opnd1,  const AR_TYPE *opnd1type,
01017    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
01018 
01019         ar_data multiplicand, multiplier, accum, newaccum, temp;
01020         AR_TYPE uint32_artype = AR_Int_32_U;
01021         AR_TYPE uint64_artype = AR_Int_64_U;
01022         unsigned long partialmult;
01023         int status = AR_STAT_OK;
01024         int result_negative;
01025 
01026         int part_a, part_b, part_c, part_d, part_e, part_f, part_g, part_h;
01027 
01028         switch (AR_INT_SIZE (*opnd1type)) {
01029         case AR_INT_SIZE_8:
01030                 result_negative = AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
01031                                   INT8_SIGN(opnd1);
01032                 if (result_negative)
01033                         ar_negate_integer (&multiplicand, opnd1type, opnd1,
01034                                            opnd1type);
01035                 else
01036                         multiplicand.ar_i8 = opnd1->ar_i8;
01037                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED &&
01038                     INT8_SIGN(opnd2)) {
01039                         result_negative ^= 1;
01040                         ar_negate_integer (&multiplier, opnd2type, opnd2,
01041                                            opnd2type);
01042                 } else
01043                         multiplier.ar_i8 = opnd2->ar_i8;
01044 
01045                 /* Preload fields into registers */
01046                 part_a = multiplicand.ar_i8.part5;
01047                 part_b = multiplier.ar_i8.part5;
01048 
01049                 /* Initialize accumulator to a * b */
01050                 partialmult = part_a * part_b;
01051                 if (partialmult >> 8)
01052                         status |= AR_STAT_OVERFLOW;
01053                 ZERO_INT8_UPPER(&accum);
01054                 accum.ar_i8.part5 = partialmult;
01055 
01056                 if (result_negative) {
01057                         ar_negate_integer (result, resulttype, &accum,
01058                                            resulttype);
01059                         if (!INT8_SIGN(result) && !IS_INT8_ZERO(result))
01060                                 status |= AR_STAT_OVERFLOW;
01061                 } else {
01062                         result->ar_i8 = accum.ar_i8;
01063                         if (INT8_SIGN(result) &&
01064                             (AR_SIGNEDNESS(*resulttype) == AR_SIGNED)) {
01065                                 status |= AR_STAT_OVERFLOW;
01066                         }
01067                 }
01068 
01069                 /* Inlined from AR_status routine: */
01070                 status &= AR_STAT_OVERFLOW;
01071                 if (IS_INT8_ZERO(result))
01072                         status |= AR_STAT_ZERO;
01073                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
01074                          INT8_SIGN(result))
01075                         status |= AR_STAT_NEGATIVE;
01076                 break;
01077 
01078         case AR_INT_SIZE_16:
01079                 result_negative = AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
01080                                   INT16_SIGN(opnd1);
01081                 if (result_negative)
01082                         ar_negate_integer (&multiplicand, opnd1type, opnd1,
01083                                            opnd1type);
01084                 else
01085                         multiplicand.ar_i64 = opnd1->ar_i64;
01086                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED &&
01087                     INT16_SIGN(opnd2)) {
01088                         result_negative ^= 1;
01089                         ar_negate_integer (&multiplier, opnd2type, opnd2,
01090                                            opnd2type);
01091                 } else
01092                         multiplier.ar_i64 = opnd2->ar_i64;
01093 
01094                 /* Preload fields into registers */
01095                 part_a = multiplicand.ar_i64.part4;
01096                 part_b = multiplier.ar_i64.part4;
01097 
01098                 /* Initialize accumulator to a * b */
01099                 partialmult = part_a * part_b;
01100                 if (partialmult >> 16)
01101                         status |= AR_STAT_OVERFLOW;
01102                 ZERO_INT16_UPPER(&accum);
01103                 accum.ar_i64.part4 = partialmult;
01104 
01105                 if (result_negative) {
01106                         ar_negate_integer (result, resulttype, &accum,
01107                                            resulttype);
01108                         if (!INT16_SIGN(result) && !IS_INT16_ZERO(result))
01109                                 status |= AR_STAT_OVERFLOW;
01110                 } else {
01111                         result->ar_i64 = accum.ar_i64;
01112                         if (INT16_SIGN(result) &&
01113                             (AR_SIGNEDNESS(*resulttype) == AR_SIGNED)) {
01114                                 status |= AR_STAT_OVERFLOW;
01115                         }
01116                 }
01117 
01118                 /* Inlined from AR_status routine: */
01119                 status &= AR_STAT_OVERFLOW;
01120                 if (IS_INT16_ZERO(result))
01121                         status |= AR_STAT_ZERO;
01122                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
01123                          INT16_SIGN(result))
01124                         status |= AR_STAT_NEGATIVE;
01125                 break;
01126 
01127         case AR_INT_SIZE_32:
01128                 result_negative = AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
01129                                   INT32_SIGN(opnd1);
01130                 if (result_negative)
01131                         ar_negate_integer (&multiplicand, opnd1type, opnd1,
01132                                            opnd1type);
01133                 else
01134                         multiplicand.ar_i64 = opnd1->ar_i64;
01135                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED &&
01136                     INT32_SIGN(opnd2)) {
01137                         result_negative ^= 1;
01138                         ar_negate_integer (&multiplier, opnd2type, opnd2,
01139                                            opnd2type);
01140                 } else
01141                         multiplier.ar_i64 = opnd2->ar_i64;
01142 
01143                 /* Preload fields into registers */
01144                 part_a = multiplicand.ar_i64.part3;
01145                 part_b = multiplicand.ar_i64.part4;
01146                 part_c = multiplier.ar_i64.part3;
01147                 part_d = multiplier.ar_i64.part4;
01148 
01149                 /* Initialize accumulator to b * d */
01150                 partialmult = part_b * part_d;
01151                 ZERO_INT32_UPPER(&accum);
01152                 accum.ar_i64.part3 = (partialmult & 0xFFFF0000) >> 16;
01153                 accum.ar_i64.part4 = partialmult & 0xFFFF;
01154 
01155                 newaccum.ar_i64.part1 = newaccum.ar_i64.part2 = 0;
01156 
01157                 /*
01158                  *       a  b
01159                  *   x   c  d
01160                  *   --------------------
01161                  *      ad bd
01162                  *   ac bc
01163                  */
01164 
01165                 /* .d */
01166                 if (part_d) {
01167 
01168                         /* bd computed above */
01169 
01170                         /* ad */
01171                         if (part_a) {
01172                                 partialmult = part_a * part_d;
01173                                 if (partialmult >> 16)
01174                                         status |= AR_STAT_OVERFLOW;
01175                                 temp.ar_i64.part3 = partialmult;
01176                                 temp.ar_i64.part4 = 0;
01177                                 status |= ar_add_integer (&newaccum,
01178                                                           &uint32_artype,
01179                                                           &accum,
01180                                                           &uint32_artype,
01181                                                           &temp,
01182                                                           &uint32_artype);
01183                                 accum.ar_i64 = newaccum.ar_i64;
01184                         }
01185                 }
01186 
01187                 /* .c */
01188                 if (part_c) {
01189 
01190                         /* bc */
01191                         if (part_b) {
01192                                 partialmult = part_b * part_c;
01193                                 if (partialmult >> 16)
01194                                         status |= AR_STAT_OVERFLOW;
01195                                 temp.ar_i64.part3 = partialmult;
01196                                 temp.ar_i64.part4 = 0;
01197                                 status |= ar_add_integer (&newaccum,
01198                                                           &uint32_artype,
01199                                                           &accum,
01200                                                           &uint32_artype,
01201                                                           &temp,
01202                                                           &uint32_artype);
01203                                 accum.ar_i64 = newaccum.ar_i64;
01204                         }
01205 
01206                         /* ac */
01207                         if (part_a)
01208                                 status |= AR_STAT_OVERFLOW;
01209                 }
01210 
01211                 /* Result is all summed up. */
01212 
01213                 if (result_negative) {
01214                         ar_negate_integer (result, resulttype, &accum,
01215                                            resulttype);
01216                         if (!INT32_SIGN(result) && !IS_INT32_ZERO(result))
01217                                 status |= AR_STAT_OVERFLOW;
01218                 } else {
01219                         result->ar_i64 = accum.ar_i64;
01220                         if (INT32_SIGN(result) &&
01221                             (AR_SIGNEDNESS(*resulttype) == AR_SIGNED)) {
01222                                 status |= AR_STAT_OVERFLOW;
01223                         }
01224                 }
01225 
01226                 /* Inlined from AR_status routine: */
01227                 status &= AR_STAT_OVERFLOW;
01228                 if (IS_INT32_ZERO(result))
01229                         status |= AR_STAT_ZERO;
01230                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
01231                          INT32_SIGN(result))
01232                         status |= AR_STAT_NEGATIVE;
01233                 break;
01234 
01235         case AR_INT_SIZE_46:
01236         case AR_INT_SIZE_64:
01237                 if (*opnd1type == AR_Int_46_S && INT_OVERFLOWS_46_BITS(*opnd1))
01238                         status |= AR_STAT_OVERFLOW;
01239                 if (*opnd2type == AR_Int_46_S && INT_OVERFLOWS_46_BITS(*opnd2))
01240                         status |= AR_STAT_OVERFLOW;
01241 
01242                 result_negative = AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
01243                                   INT64_SIGN(opnd1);
01244                 if (result_negative)
01245                         ar_negate_integer (&multiplicand, opnd1type, opnd1,
01246                                            opnd1type);
01247                 else
01248                         multiplicand.ar_i64 = opnd1->ar_i64;
01249                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED &&
01250                     INT64_SIGN(opnd2)) {
01251                         result_negative ^= 1;
01252                         ar_negate_integer (&multiplier, opnd2type, opnd2,
01253                                            opnd2type);
01254                 } else
01255                         multiplier.ar_i64 = opnd2->ar_i64;
01256 
01257                 /* Preload fields into registers */
01258                 part_a = multiplicand.ar_i64.part1;
01259                 part_b = multiplicand.ar_i64.part2;
01260                 part_c = multiplicand.ar_i64.part3;
01261                 part_d = multiplicand.ar_i64.part4;
01262                 part_e = multiplier.ar_i64.part1;
01263                 part_f = multiplier.ar_i64.part2;
01264                 part_g = multiplier.ar_i64.part3;
01265                 part_h = multiplier.ar_i64.part4;
01266 
01267                 /* Initialize accumulator to d * h */
01268                 partialmult = part_d * part_h;
01269                 ZERO_INT32_UPPER(&accum);
01270                 accum.ar_i64.part3 = (partialmult & 0xFFFF0000) >> 16;
01271                 accum.ar_i64.part4 = partialmult & 0xFFFF;
01272 
01273                 /*
01274                  *             a  b  c  d 
01275                  *   x         e  f  g  h 
01276                  *   --------------------
01277                  *            ah bh ch dh
01278                  *         ag bg cg dg
01279                  *      af bf cf df
01280                  *   ae be ce de
01281                  */
01282 
01283                 /* .h */
01284                 if (part_h) {
01285 
01286                         /* dh computed above */
01287 
01288                         /* ch */
01289                         if (part_c) {
01290                                 partialmult = part_c * part_h;
01291                                 temp.ar_i64.part1 = temp.ar_i64.part4 = 0;
01292                                 temp.ar_i64.part2 = partialmult >> 16;
01293                                 temp.ar_i64.part3 = partialmult;
01294                                 status |= ar_add_integer (&newaccum,
01295                                                           &uint64_artype,
01296                                                           &accum,
01297                                                           &uint64_artype,
01298                                                           &temp,
01299                                                           &uint64_artype);
01300                                 accum.ar_i64 = newaccum.ar_i64;
01301                         }
01302 
01303                         /* bh */
01304                         if (part_b) {
01305                                 partialmult = part_b * part_h;
01306                                 temp.ar_i64.part1 = partialmult >> 16;
01307                                 temp.ar_i64.part2 = partialmult;
01308                                 temp.ar_i64.part3 = temp.ar_i64.part4 = 0;
01309                                 status |= ar_add_integer (&newaccum,
01310                                                           &uint64_artype,
01311                                                           &accum,
01312                                                           &uint64_artype,
01313                                                           &temp,
01314                                                           &uint64_artype);
01315                                 accum.ar_i64 = newaccum.ar_i64;
01316                         }
01317 
01318                         /* ah */
01319                         if (part_a) {
01320                                 partialmult = part_a * part_h;
01321                                 if (partialmult >> 16)
01322                                         status |= AR_STAT_OVERFLOW;
01323                                 temp.ar_i64.part1 = partialmult;
01324                                 temp.ar_i64.part2 = temp.ar_i64.part3 =
01325                                         temp.ar_i64.part4 = 0;
01326                                 status |= ar_add_integer (&newaccum,
01327                                                           &uint64_artype,
01328                                                           &accum,
01329                                                           &uint64_artype,
01330                                                           &temp,
01331                                                           &uint64_artype);
01332                                 accum.ar_i64 = newaccum.ar_i64;
01333                         }
01334                 }
01335 
01336                 /* .g */
01337                 if (part_g) {
01338 
01339                         /* dg */
01340                         if (part_d) {
01341                                 partialmult = part_d * part_g;
01342                                 temp.ar_i64.part1 = temp.ar_i64.part4 = 0;
01343                                 temp.ar_i64.part2 = partialmult >> 16;
01344                                 temp.ar_i64.part3 = partialmult;
01345                                 status |= ar_add_integer (&newaccum,
01346                                                           &uint64_artype,
01347                                                           &accum,
01348                                                           &uint64_artype,
01349                                                           &temp,
01350                                                           &uint64_artype);
01351                                 accum.ar_i64 = newaccum.ar_i64;
01352                         }
01353 
01354                         /* cg */
01355                         if (part_c) {
01356                                 partialmult = part_c * part_g;
01357                                 temp.ar_i64.part1 = partialmult >> 16;
01358                                 temp.ar_i64.part2 = partialmult;
01359                                 temp.ar_i64.part3 = temp.ar_i64.part4 = 0;
01360                                 status |= ar_add_integer (&newaccum,
01361                                                           &uint64_artype,
01362                                                           &accum,
01363                                                           &uint64_artype,
01364                                                           &temp,
01365                                                           &uint64_artype);
01366                                 accum.ar_i64 = newaccum.ar_i64;
01367                         }
01368 
01369                         /* bg */
01370                         if (part_b) {
01371                                 partialmult = part_b * part_g;
01372                                 if (partialmult >> 16)
01373                                         status |= AR_STAT_OVERFLOW;
01374                                 temp.ar_i64.part1 = partialmult;
01375                                 temp.ar_i64.part2 = temp.ar_i64.part3 =
01376                                         temp.ar_i64.part4 = 0;
01377                                 status |= ar_add_integer (&newaccum,
01378                                                           &uint64_artype,
01379                                                           &accum,
01380                                                           &uint64_artype,
01381                                                           &temp,
01382                                                           &uint64_artype);
01383                                 accum.ar_i64 = newaccum.ar_i64;
01384                         }
01385 
01386                         /* ag */
01387                         if (part_a)
01388                                 status |= AR_STAT_OVERFLOW;
01389                 }
01390 
01391                 /* .f */
01392                 if (part_f) {
01393 
01394                         /* df */
01395                         if (part_d) {
01396                                 partialmult = part_d * part_f;
01397                                 temp.ar_i64.part1 = partialmult >> 16;
01398                                 temp.ar_i64.part2 = partialmult;
01399                                 temp.ar_i64.part3 = temp.ar_i64.part4 = 0;
01400                                 status |= ar_add_integer (&newaccum,
01401                                                           &uint64_artype,
01402                                                           &accum,
01403                                                           &uint64_artype,
01404                                                           &temp,
01405                                                           &uint64_artype);
01406                                 accum.ar_i64 = newaccum.ar_i64;
01407                         }
01408 
01409                         /* cf */
01410                         if (part_c) {
01411                                 partialmult = part_c * part_f;
01412                                 if (partialmult >> 16)
01413                                         status |= AR_STAT_OVERFLOW;
01414                                 temp.ar_i64.part1 = partialmult;
01415                                 temp.ar_i64.part2 = temp.ar_i64.part3 =
01416                                         temp.ar_i64.part4 = 0;
01417                                 status |= ar_add_integer (&newaccum,
01418                                                           &uint64_artype,
01419                                                           &accum,
01420                                                           &uint64_artype,
01421                                                           &temp,
01422                                                           &uint64_artype);
01423                                 accum.ar_i64 = newaccum.ar_i64;
01424                         }
01425 
01426                         /* bf, af */
01427                         if (part_a | part_b)
01428                                 status |= AR_STAT_OVERFLOW;
01429                 }
01430 
01431                 /* .e */
01432                 if (part_e) {
01433 
01434                         /* de */
01435                         if (part_d) {
01436                                 partialmult = part_d * part_e;
01437                                 if (partialmult >> 16)
01438                                         status |= AR_STAT_OVERFLOW;
01439                                 temp.ar_i64.part1 = partialmult;
01440                                 temp.ar_i64.part2 = temp.ar_i64.part3 =
01441                                         temp.ar_i64.part4 = 0;
01442                                 status |= ar_add_integer (&newaccum,
01443                                                           &uint64_artype,
01444                                                           &accum,
01445                                                           &uint64_artype,
01446                                                           &temp,
01447                                                           &uint64_artype);
01448                                 accum.ar_i64 = newaccum.ar_i64;
01449                         }
01450 
01451                         /* ce, be, ae */
01452                         if (part_a | part_b | part_c)
01453                                 status |= AR_STAT_OVERFLOW;
01454                 }
01455 
01456                 /* Result is all summed up. */
01457 
01458                 if (result_negative) {
01459                         ar_negate_integer (result, resulttype, &accum,
01460                                            resulttype);
01461                         if (!INT64_SIGN(result) && !IS_INT64_ZERO(result))
01462                                 status |= AR_STAT_OVERFLOW;
01463                 } else {
01464                         result->ar_i64 = accum.ar_i64;
01465                         if (INT64_SIGN(result) &&
01466                             (AR_SIGNEDNESS(*resulttype) == AR_SIGNED)) {
01467                                 status |= AR_STAT_OVERFLOW;
01468                         }
01469                 }
01470 
01471                 if (*resulttype == AR_Int_46_S &&
01472                     INT_OVERFLOWS_46_BITS (*result))
01473                         status |= AR_STAT_OVERFLOW;
01474 
01475                 /* Inlined from AR_status routine: */
01476                 status &= AR_STAT_OVERFLOW;
01477                 if (IS_INT64_ZERO(result))
01478                         status |= AR_STAT_ZERO;
01479                 else if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
01480                          INT64_SIGN(result))
01481                         status |= AR_STAT_NEGATIVE;
01482                 break;
01483 
01484         default:
01485                 return (AR_STAT_INVALID_TYPE);
01486         }
01487 
01488         return status;
01489 }
01490 
01491 
01492 static
01493 int
01494 ar_multiply_float
01495                 (ar_data *result, const AR_TYPE *resulttype,
01496    const ar_data *opnd1,  const AR_TYPE *opnd1type,
01497    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
01498 
01499         int status;
01500 
01501         ar_data tmp1, tmp2;
01502 
01503         switch (*opnd1type) {
01504         case AR_Float_Cray1_64:
01505         case AR_Float_Cray1_64_F:
01506                 status = ar_cfmul64 (&result->ar_f64,
01507                                      &opnd1->ar_f64, &opnd2->ar_f64,
01508                                      ROUND_MODE (*opnd1type));
01509                 if (ar_state_register.ar_truncate_bits > 0)
01510                         ar_CRAY_64_trunc(&result->ar_f64);
01511                 return status;
01512 
01513         case AR_Float_Cray1_128:
01514                 return ar_cfmul128 (&result->ar_f128,
01515                                     &opnd1->ar_f128, &opnd2->ar_f128,
01516                                     ROUND_MODE (*opnd1type));
01517         case AR_Float_IEEE_NR_32:
01518         case AR_Float_IEEE_ZE_32:
01519         case AR_Float_IEEE_UP_32:
01520         case AR_Float_IEEE_DN_32:
01521                 return ar_ifmul32 (&result->ar_ieee32,
01522                                    &opnd1->ar_ieee32, &opnd2->ar_ieee32,
01523                                    ROUND_MODE (*opnd1type));
01524         case AR_Float_IEEE_NR_64:
01525         case AR_Float_IEEE_ZE_64:
01526         case AR_Float_IEEE_UP_64:
01527         case AR_Float_IEEE_DN_64:
01528                 return ar_ifmul64 (&result->ar_ieee64,
01529                                    &opnd1->ar_ieee64, &opnd2->ar_ieee64,
01530                                    ROUND_MODE (*opnd1type));
01531         case AR_Float_IEEE_NR_128:
01532         case AR_Float_IEEE_ZE_128:
01533         case AR_Float_IEEE_UP_128:
01534         case AR_Float_IEEE_DN_128:
01535                 return ar_ifmul128 (&result->ar_ieee128,
01536                                    &opnd1->ar_ieee128, &opnd2->ar_ieee128,
01537                                    ROUND_MODE (*opnd1type));
01538         default:
01539                 return AR_STAT_INVALID_TYPE;
01540         }
01541 }
01542 
01543 
01544 static
01545 int
01546 ar_multiply_complex
01547                 (ar_data *result, const AR_TYPE *resulttype,
01548    const ar_data *opnd1,  const AR_TYPE *opnd1type,
01549    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
01550 
01551         AR_DATA a, b, c, d, ac, bd, ad, bc, re, im;
01552         AR_TYPE reimtype1, reimtype2, temptype;
01553         int status, restat, imstat;
01554 
01555         /* (a + bi)*(c + di) = (ac - bd) + (ad + bc)i */
01556 
01557         status =  ar_decompose_complex ((ar_data*)&a, (ar_data*)&b, &reimtype1,
01558                                                                         opnd1, opnd1type);
01559         status |= ar_decompose_complex ((ar_data*)&c, (ar_data*)&d, &reimtype2,
01560                                                                         opnd2, opnd2type);
01561 
01562         status |= AR_multiply (&ac, &reimtype1, &a, &reimtype1, &c, &reimtype2);
01563         status |= AR_multiply (&bd, &reimtype1, &b, &reimtype1, &d, &reimtype2);
01564         status |= AR_multiply (&ad, &reimtype1, &a, &reimtype1, &d, &reimtype2);
01565         status |= AR_multiply (&bc, &reimtype1, &b, &reimtype1, &c, &reimtype2);
01566 
01567         restat = AR_subtract (&re, &reimtype1, &ac, &reimtype1, &bd, &reimtype1);
01568         imstat = AR_add      (&im, &reimtype1, &ad, &reimtype1, &bc, &reimtype1);
01569         status |= restat | imstat;
01570 
01571         status |= ar_compose_complex (result, &temptype,
01572                                                                   (ar_data*)&re, (ar_data*)&im, &reimtype1);
01573 
01574         status &= ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
01575         status |= restat | imstat | AR_STAT_ZERO;
01576         return status;
01577 }
01578 
01579 
01580 /* General dispatch routine for multiplication */
01581 int
01582 AR_multiply
01583                 (AR_DATA *res, const AR_TYPE *resulttype,
01584    const AR_DATA *op1, const AR_TYPE *opnd1type,
01585    const AR_DATA *op2, const AR_TYPE *opnd2type) {
01586 
01587         ar_data* result = (ar_data*)res;
01588         ar_data* opnd1  = (ar_data*)op1;
01589         ar_data* opnd2  = (ar_data*)op2;
01590 
01591         if (*resulttype != *opnd1type || *resulttype != *opnd2type)
01592                 return AR_STAT_INVALID_TYPE;
01593 
01594         if (AR_CLASS (*resulttype) == AR_CLASS_INT)
01595                 if (AR_INT_SIZE (*resulttype) != AR_INT_SIZE_8 &&
01596                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_16 &&
01597                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_32 &&
01598                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_46 &&
01599                     AR_INT_SIZE (*resulttype) != AR_INT_SIZE_64) {
01600                         return AR_STAT_INVALID_TYPE;
01601                 }
01602                 else {
01603                         int status;
01604 
01605                         status = ar_multiply_integer(result, resulttype,
01606                                                      opnd1, opnd1type,
01607                                                      opnd2, opnd2type);
01608                         if (AR_SIGNEDNESS(*resulttype) == AR_UNSIGNED) {
01609                                 /* turn off overflow flag for unsigned result */
01610                                 status &= ~AR_STAT_OVERFLOW;
01611                         }
01612 
01613                         return (status);
01614                 }
01615 
01616         if (AR_CLASS (*resulttype) == AR_CLASS_FLOAT)
01617                 if (AR_FLOAT_IS_COMPLEX (*resulttype) == AR_FLOAT_COMPLEX)
01618                         return ar_multiply_complex (result, resulttype,
01619                                                     opnd1, opnd1type,
01620                                                     opnd2, opnd2type);
01621                 else
01622                         return ar_multiply_float (result, resulttype,
01623                                                   opnd1, opnd1type,
01624                                                   opnd2, opnd2type);
01625 
01626         return AR_STAT_INVALID_TYPE;
01627 }
01628 
01629 
01630 /* Integer division */
01631 int
01632 ar_divide_integer
01633                 (ar_data *result1, const AR_TYPE *result1type,
01634                  ar_data *result2, const AR_TYPE *result2type,
01635    const ar_data *opnd1,   const AR_TYPE *opnd1type,
01636    const ar_data *opnd2,   const AR_TYPE *opnd2type) {
01637 
01638         ar_data dividend, divisor, accum, shiftcount, temp;
01639         ar_data lzdividend, lzdivisor;
01640 
01641         AR_TYPE type8  = AR_Int_8_U;
01642         AR_TYPE type16 = AR_Int_16_U;
01643         AR_TYPE type32 = AR_Int_32_U;
01644         AR_TYPE type64 = AR_Int_64_U;
01645 
01646         int opnd1sign, opnd2sign;
01647         int seqcount;
01648 
01649         switch (AR_INT_SIZE (*opnd1type)) {
01650         case AR_INT_SIZE_8:
01651                 ZERO_INT8_UPPER(result1);
01652                 ZERO_INT8_UPPER(result2);
01653 
01654                 /* Check for division by zero */
01655                 if (IS_INT8_ZERO(opnd2)) {
01656                         ZERO_INT8(result1);
01657                         ZERO_INT8(result2);
01658                         return AR_STAT_OVERFLOW;
01659                 }
01660 
01661                 if (IS_INT8_ZERO(opnd1)) {
01662                         ZERO_INT8(result1);
01663                         ZERO_INT8(result2);
01664                         return AR_STAT_ZERO;
01665                 }
01666 
01667                 opnd1sign = INT8_SIGN(opnd1) != 0;
01668                 opnd2sign = INT8_SIGN(opnd2) != 0;
01669 
01670                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
01671                         ar_negate_integer (&dividend, opnd1type,
01672                                            opnd1, opnd1type);
01673                 else
01674                         dividend = *opnd1;
01675 
01676                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED && opnd2sign)
01677                         ar_negate_integer (&divisor, opnd2type,
01678                                            opnd2, opnd2type);
01679                 else
01680                         divisor = *opnd2;
01681 
01682                 ZERO_INT8_UPPER(&dividend);
01683                 ZERO_INT8_UPPER(&divisor );
01684                 ZERO_INT8_UPPER(&temp    );
01685 
01686                 ZERO_INT8_ALL(&accum);
01687 
01688                 /* Compute difference in leading zero counts */
01689                 AR_leadz ((AR_DATA*)&lzdividend, &type8,
01690                           (AR_DATA*)&dividend, &type8);
01691                 AR_leadz ((AR_DATA*)&lzdivisor, &type8,
01692                           (AR_DATA*)&divisor, &type8);
01693                 ar_subtract_integer (&shiftcount, &type8, (int *) 0,
01694                                      &lzdivisor, &type8,
01695                                      &lzdividend, &type8);
01696 
01697                 if (!INT8_SIGN(&shiftcount)) {
01698                         if (shiftcount.ar_i8.part5 & 0xF8)
01699                                 ar_internal_error (2001, __FILE__, __LINE__);
01700                         seqcount = shiftcount.ar_i8.part5 + 1;
01701                         AR_shiftl ((AR_DATA*)&temp, &type8,
01702                                    (AR_DATA*)&divisor, &type8,
01703                                    (AR_DATA*)&shiftcount, &type8);
01704                         divisor = temp;
01705 
01706                         shiftcount.ar_i8.part5 = 1;
01707 
01708                         do {
01709                                 AR_shiftl ((AR_DATA*)&temp, &type8,
01710                                            (AR_DATA*)&accum, &type8,
01711                                            (AR_DATA*)&shiftcount, &type8);
01712                                 accum = temp;
01713                                 ar_subtract_integer (&temp, &type8, (int *)0,
01714                                                      &dividend, &type8,
01715                                                      &divisor, &type8);
01716                                 if (!INT8_SIGN(&temp)) {
01717                                         accum.ar_i8.part5 |= 1;
01718                                         dividend = temp;
01719                                 }
01720                                 AR_shiftr ((AR_DATA*)&temp, &type8,
01721                                            (AR_DATA*)&divisor, &type8,
01722                                            (AR_DATA*)&shiftcount, &type8);
01723                                 divisor = temp;
01724 
01725                         } while (--seqcount > 0);
01726                 }
01727 
01728                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
01729                     opnd1sign != opnd2sign)
01730                         ar_negate_integer (result1, result1type,
01731                                            &accum, &type8);
01732                 else
01733                         result1->ar_i64 = accum.ar_i64;
01734 
01735                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
01736                         ar_negate_integer (result2, result2type,
01737                                            &dividend, &type8);
01738                 else
01739                         result2->ar_i64 = dividend.ar_i64;
01740                 break;
01741 
01742         case AR_INT_SIZE_16:
01743                 ZERO_INT16_UPPER(result1);
01744                 ZERO_INT16_UPPER(result2);
01745 
01746                 /* Check for division by zero */
01747                 if (IS_INT16_ZERO(opnd2)) {
01748                         ZERO_INT16(result1);
01749                         ZERO_INT16(result2);
01750                         return AR_STAT_OVERFLOW;
01751                 }
01752 
01753                 if (IS_INT16_ZERO(opnd1)) {
01754                         ZERO_INT16(result1);
01755                         ZERO_INT16(result2);
01756                         return AR_STAT_ZERO;
01757                 }
01758 
01759                 opnd1sign = INT16_SIGN(opnd1) != 0;
01760                 opnd2sign = INT16_SIGN(opnd2) != 0;
01761 
01762                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
01763                         ar_negate_integer (&dividend, opnd1type,
01764                                            opnd1, opnd1type);
01765                 else
01766                         dividend = *opnd1;
01767 
01768                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED && opnd2sign)
01769                         ar_negate_integer (&divisor, opnd2type,
01770                                            opnd2, opnd2type);
01771                 else
01772                         divisor = *opnd2;
01773 
01774                 ZERO_INT16_UPPER(&dividend);
01775                 ZERO_INT16_UPPER(&divisor );
01776                 ZERO_INT16_UPPER(&temp    );
01777 
01778                 ZERO_INT16_ALL(&accum);
01779 
01780                 /* Compute difference in leading zero counts */
01781                 AR_leadz ((AR_DATA*)&lzdividend, &type16,
01782                           (AR_DATA*)&dividend, &type16);
01783                 AR_leadz ((AR_DATA*)&lzdivisor, &type16,
01784                           (AR_DATA*)&divisor, &type16);
01785                 ar_subtract_integer (&shiftcount, &type16, (int *) 0,
01786                                      &lzdivisor, &type16,
01787                                      &lzdividend, &type16);
01788 
01789                 if (!INT16_SIGN(&shiftcount)) {
01790                         if (shiftcount.ar_i64.part4 & 0xFFF0)
01791                                 ar_internal_error (2001, __FILE__, __LINE__);
01792                         seqcount = shiftcount.ar_i64.part4 + 1;
01793                         AR_shiftl ((AR_DATA*)&temp, &type16,
01794                                    (AR_DATA*)&divisor, &type16,
01795                                    (AR_DATA*)&shiftcount, &type16);
01796                         divisor = temp;
01797 
01798                         shiftcount.ar_i64.part4 = 1;
01799 
01800                         do {
01801                                 AR_shiftl ((AR_DATA*)&temp, &type16,
01802                                            (AR_DATA*)&accum, &type16,
01803                                            (AR_DATA*)&shiftcount, &type16);
01804                                 accum = temp;
01805                                 ar_subtract_integer (&temp, &type16, (int *)0,
01806                                                      &dividend, &type16,
01807                                                      &divisor, &type16);
01808                                 if (!INT16_SIGN(&temp)) {
01809                                         accum.ar_i64.part4 |= 1;
01810                                         dividend = temp;
01811                                 }
01812                                 AR_shiftr ((AR_DATA*)&temp, &type16,
01813                                            (AR_DATA*)&divisor, &type16,
01814                                            (AR_DATA*)&shiftcount, &type16);
01815                                 divisor = temp;
01816 
01817                         } while (--seqcount > 0);
01818                 }
01819 
01820                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
01821                     opnd1sign != opnd2sign)
01822                         ar_negate_integer (result1, result1type,
01823                                            &accum, &type16);
01824                 else
01825                         result1->ar_i64 = accum.ar_i64;
01826 
01827                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
01828                         ar_negate_integer (result2, result2type,
01829                                            &dividend, &type16);
01830                 else
01831                         result2->ar_i64 = dividend.ar_i64;
01832                 break;
01833 
01834         case AR_INT_SIZE_32:
01835                 ZERO_INT32_UPPER(result1);
01836                 ZERO_INT32_UPPER(result2);
01837 
01838                 /* Check for division by zero */
01839                 if (IS_INT32_ZERO(opnd2)) {
01840                         ZERO_INT32(result1);
01841                         ZERO_INT32(result2);
01842                         return AR_STAT_OVERFLOW;
01843                 }
01844 
01845                 if (IS_INT32_ZERO(opnd1)) {
01846                         ZERO_INT32(result1);
01847                         ZERO_INT32(result2);
01848                         return AR_STAT_ZERO;
01849                 }
01850 
01851                 opnd1sign = INT32_SIGN(opnd1) != 0;
01852                 opnd2sign = INT32_SIGN(opnd2) != 0;
01853 
01854                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
01855                         ar_negate_integer (&dividend, opnd1type,
01856                                            opnd1, opnd1type);
01857                 else
01858                         dividend = *opnd1;
01859 
01860                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED && opnd2sign)
01861                         ar_negate_integer (&divisor, opnd2type,
01862                                            opnd2, opnd2type);
01863                 else
01864                         divisor = *opnd2;
01865 
01866                 ZERO_INT32_UPPER(&dividend);
01867                 ZERO_INT32_UPPER(&divisor );
01868                 ZERO_INT32_UPPER(&temp    );
01869 
01870                 ZERO_INT32_ALL(&accum);
01871 
01872                 /* Compute difference in leading zero counts */
01873                 AR_leadz ((AR_DATA*)&lzdividend, &type32,
01874                           (AR_DATA*)&dividend, &type32);
01875                 AR_leadz ((AR_DATA*)&lzdivisor, &type32,
01876                           (AR_DATA*)&divisor, &type32);
01877                 ar_subtract_integer (&shiftcount, &type32, (int *) 0,
01878                                      &lzdivisor, &type32,
01879                                      &lzdividend, &type32);
01880 
01881                 if (!INT32_SIGN(&shiftcount)) {
01882                         if (shiftcount.ar_i64.part3 |
01883                             shiftcount.ar_i64.part4 & 0xFFE0)
01884                                 ar_internal_error (2001, __FILE__, __LINE__);
01885                         seqcount = shiftcount.ar_i64.part4 + 1;
01886                         AR_shiftl ((AR_DATA*)&temp, &type32,
01887                                    (AR_DATA*)&divisor, &type32,
01888                                    (AR_DATA*)&shiftcount, &type32);
01889                         divisor = temp;
01890 
01891                         shiftcount.ar_i64.part3 = 0;
01892                         shiftcount.ar_i64.part4 = 1;
01893 
01894                         do {
01895                                 AR_shiftl ((AR_DATA*)&temp, &type32,
01896                                            (AR_DATA*)&accum, &type32,
01897                                            (AR_DATA*)&shiftcount, &type32);
01898                                 accum = temp;
01899                                 ar_subtract_integer (&temp, &type32, (int *)0,
01900                                                      &dividend, &type32,
01901                                                      &divisor, &type32);
01902                                 if (!INT32_SIGN(&temp)) {
01903                                         accum.ar_i64.part4 |= 1;
01904                                         dividend = temp;
01905                                 }
01906                                 AR_shiftr ((AR_DATA*)&temp, &type32,
01907                                            (AR_DATA*)&divisor, &type32,
01908                                            (AR_DATA*)&shiftcount, &type32);
01909                                 divisor = temp;
01910 
01911                         } while (--seqcount > 0);
01912                 }
01913 
01914                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
01915                     opnd1sign != opnd2sign)
01916                         ar_negate_integer (result1, result1type,
01917                                            &accum, &type32);
01918                 else
01919                         result1->ar_i64 = accum.ar_i64;
01920 
01921                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
01922                         ar_negate_integer (result2, result2type,
01923                                            &dividend, &type32);
01924                 else
01925                         result2->ar_i64 = dividend.ar_i64;
01926                 break;
01927 
01928         case AR_INT_SIZE_46:
01929         case AR_INT_SIZE_64:
01930                 /* Check for division by zero */
01931                 if (IS_INT64_ZERO(opnd2)) {
01932                         ZERO_INT64(result1);
01933                         ZERO_INT64(result2);
01934                         return AR_STAT_OVERFLOW;
01935                 }
01936 
01937                 if (IS_INT64_ZERO(opnd1)) {
01938                         ZERO_INT64(result1);
01939                         ZERO_INT64(result2);
01940                         return AR_STAT_ZERO;
01941                 }
01942 
01943                 opnd1sign = INT64_SIGN(opnd1) != 0;
01944                 opnd2sign = INT64_SIGN(opnd2) != 0;
01945 
01946                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
01947                         ar_negate_integer (&dividend, opnd1type,
01948                                            opnd1, opnd1type);
01949                 else
01950                         dividend = *opnd1;
01951 
01952                 if (AR_SIGNEDNESS (*opnd2type) == AR_SIGNED && opnd2sign)
01953                         ar_negate_integer (&divisor, opnd2type, opnd2,
01954                                            opnd2type);
01955                 else
01956                         divisor = *opnd2;
01957 
01958                 ZERO_INT64_ALL(&accum);
01959 
01960                 /* Compute difference in leading zero counts */
01961                 AR_leadz ((AR_DATA*)&lzdividend, &type64,
01962                           (AR_DATA*)&dividend, &type64);
01963                 AR_leadz ((AR_DATA*)&lzdivisor, &type64,
01964                           (AR_DATA*)&divisor, &type64);
01965                 ar_subtract_integer (&shiftcount, &type64, (int *) 0,
01966                                      &lzdivisor, &type64,
01967                                      &lzdividend, &type64);
01968 
01969                 if (!INT64_SIGN(&shiftcount)) {
01970                         if (shiftcount.ar_i64.part1 |
01971                             shiftcount.ar_i64.part2 |
01972                             shiftcount.ar_i64.part3 |
01973                             shiftcount.ar_i64.part4 & 0xFFC0)
01974                                 ar_internal_error (2001, __FILE__, __LINE__);
01975                         seqcount = shiftcount.ar_i64.part4 + 1;
01976                         AR_shiftl ((AR_DATA*)&temp, &type64,
01977                                    (AR_DATA*)&divisor, &type64,
01978                                    (AR_DATA*)&shiftcount, &type64);
01979                         divisor = temp;
01980 
01981                         shiftcount.ar_i64.part1 = shiftcount.ar_i64.part2 =
01982                                 shiftcount.ar_i64.part3 = 0;
01983                         shiftcount.ar_i64.part4 = 1;
01984 
01985                         do {
01986                                 AR_shiftl ((AR_DATA*)&temp, &type64,
01987                                            (AR_DATA*)&accum, &type64,
01988                                            (AR_DATA*)&shiftcount, &type64);
01989                                 accum = temp;
01990                                 ar_subtract_integer (&temp, &type64,
01991                                                      (int *)0,
01992                                                      &dividend, &type64,
01993                                                      &divisor, &type64);
01994                                 if (!INT64_SIGN(&temp)) {
01995                                         accum.ar_i64.part4 |= 1;
01996                                         dividend = temp;
01997                                 }
01998                                 AR_shiftr ((AR_DATA*)&temp, &type64,
01999                                            (AR_DATA*)&divisor, &type64,
02000                                            (AR_DATA*)&shiftcount, &type64);
02001                                 divisor = temp;
02002 
02003                         } while (--seqcount > 0);
02004                 }
02005 
02006                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED &&
02007                     opnd1sign != opnd2sign)
02008                         ar_negate_integer (result1, result1type,
02009                                            &accum, &type64);
02010                 else
02011                         result1->ar_i64 = accum.ar_i64;
02012 
02013                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED && opnd1sign)
02014                         ar_negate_integer (result2, result2type,
02015                                            &dividend, &type64);
02016                 else
02017                         result2->ar_i64 = dividend.ar_i64;
02018                 break;
02019 
02020         default:
02021                 return (AR_STAT_INVALID_TYPE);
02022         }
02023 
02024         return AR_STAT_OK;
02025 }
02026 
02027 
02028 static
02029 int
02030 ar_divide_float
02031                 (ar_data *result, const AR_TYPE *resulttype,
02032    const ar_data *opnd1,  const AR_TYPE *opnd1type,
02033    const ar_data *opnd2,  const AR_TYPE *opnd2type) {
02034 
02035         int status;
02036 
02037         ar_data tmp1, tmp2;
02038 
02039         switch (*opnd1type) {
02040         case AR_Float_Cray1_64:
02041         case AR_Float_Cray1_64_F:
02042                 return ar_cfdiv64 (&result->ar_f64,
02043                                    &opnd1->ar_f64, &opnd2->ar_f64,
02044                                    ROUND_MODE (*opnd1type));
02045         case AR_Float_Cray1_128:
02046                 return ar_cfdiv128 (&result->ar_f128,
02047                                     &opnd1->ar_f128, &opnd2->ar_f128,
02048                                     ROUND_MODE (*opnd1type));
02049         case AR_Float_IEEE_NR_32:
02050         case AR_Float_IEEE_ZE_32:
02051         case AR_Float_IEEE_UP_32:
02052         case AR_Float_IEEE_DN_32:
02053                 return ar_ifdiv32 (&result->ar_ieee32,
02054                                    &opnd1->ar_ieee32, &opnd2->ar_ieee32,
02055                                    ROUND_MODE (*opnd1type));
02056         case AR_Float_IEEE_NR_64:
02057         case AR_Float_IEEE_ZE_64:
02058         case AR_Float_IEEE_UP_64:
02059         case AR_Float_IEEE_DN_64:
02060                 return ar_ifdiv64 (&result->ar_ieee64,
02061                                    &opnd1->ar_ieee64, &opnd2->ar_ieee64,
02062                                    ROUND_MODE (*opnd1type));
02063         case AR_Float_IEEE_NR_128:
02064         case AR_Float_IEEE_ZE_128:
02065         case AR_Float_IEEE_UP_128:
02066         case AR_Float_IEEE_DN_128:
02067                 return ar_ifdiv128 (&result->ar_ieee128,
02068                                    &opnd1->ar_ieee128, &opnd2->ar_ieee128,
02069                                    ROUND_MODE (*opnd1type));
02070         default:
02071                 return AR_STAT_INVALID_TYPE;
02072         }
02073 }
02074 
02075 
02076 /* General dispatch routine for division */
02077 int
02078 AR_divide
02079                 (AR_DATA *res, const AR_TYPE *resulttype,
02080    const AR_DATA *op1, const AR_TYPE *opnd1type,
02081    const AR_DATA *op2, const AR_TYPE *opnd2type) {
02082 
02083         ar_data* result = (ar_data*)res;
02084         ar_data* opnd1  = (ar_data*)op1;
02085         ar_data* opnd2  = (ar_data*)op2;
02086 
02087         int status, restat, imstat;
02088         ar_data modresult, real1, imag1, real2, imag2, realq, imagq;
02089         AR_TYPE reimtype, scrtype;
02090 
02091         if (*resulttype == *opnd1type &&
02092             AR_CLASS (*resulttype) == AR_CLASS_FLOAT &&
02093             AR_FLOAT_IS_COMPLEX (*resulttype) == AR_FLOAT_COMPLEX) {
02094                 status = ar_decompose_complex (&real1, &imag1, &reimtype,
02095                                                 opnd1, opnd1type);
02096                 if (reimtype == *opnd2type) {
02097                         /* COMPLEX/REAL - short sequence */
02098                         restat = ar_divide_float (&realq, &reimtype,
02099                                             &real1, &reimtype,
02100                                             opnd2, opnd2type);
02101                         imstat = ar_divide_float (&imagq, &reimtype,
02102                                             &imag1, &reimtype,
02103                                             opnd2, opnd2type);
02104                         status |= ar_compose_complex (result, &scrtype,
02105                                                       &realq, &imagq,
02106                                                       &reimtype);
02107                         status |= restat | imstat;
02108                         status &= ~(AR_STAT_ZERO | AR_STAT_NEGATIVE);
02109                         status |= restat & imstat & AR_STAT_ZERO;
02110                         return status;
02111                 }
02112         }
02113 
02114         if (*resulttype != *opnd1type || *resulttype != *opnd2type)
02115                 return AR_STAT_INVALID_TYPE;
02116 
02117         if (AR_CLASS (*opnd1type) == AR_CLASS_INT) {
02118                 if (AR_INT_SIZE (*opnd1type) != AR_INT_SIZE_8 &&
02119                     AR_INT_SIZE (*opnd1type) != AR_INT_SIZE_16 &&
02120                     AR_INT_SIZE (*opnd1type) != AR_INT_SIZE_32 &&
02121                     AR_INT_SIZE (*opnd1type) != AR_INT_SIZE_46 &&
02122                     AR_INT_SIZE (*opnd1type) != AR_INT_SIZE_64)
02123                         return AR_STAT_INVALID_TYPE;
02124                 status = ar_divide_integer (result, resulttype,
02125                                             &modresult, resulttype,
02126                                             opnd1, opnd1type,
02127                                             opnd2, opnd2type);
02128                 if (AR_SIGNEDNESS (*opnd1type) == AR_SIGNED) {
02129                         if ((*opnd1type == AR_Int_46_S &&
02130                              INT_OVERFLOWS_46_BITS (*opnd1)) ||
02131                             (*opnd2type == AR_Int_46_S &&
02132                              INT_OVERFLOWS_46_BITS (*opnd2)) ||
02133                             (*resulttype == AR_Int_46_S &&
02134                              INT_OVERFLOWS_46_BITS (*result)))
02135                                 status |= AR_STAT_OVERFLOW;
02136                         switch (AR_INT_SIZE (*opnd1type)) {
02137                         case AR_INT_SIZE_8:
02138                                 if (!IS_INT8_ZERO(result) &&
02139                                     (INT8_SIGN(opnd1) ^
02140                                      INT8_SIGN(opnd2) ^
02141                                      INT8_SIGN(result)))
02142                                         /* Nonzero result with wrong sign */
02143                                         status |= AR_STAT_OVERFLOW;
02144                                 break;
02145 
02146                         case AR_INT_SIZE_16:
02147                                 if (!IS_INT16_ZERO(result) &&
02148                                     (INT16_SIGN(opnd1) ^
02149                                      INT16_SIGN(opnd2) ^
02150                                      INT16_SIGN(result)))
02151                                         /* Nonzero result with wrong sign */
02152                                         status |= AR_STAT_OVERFLOW;
02153                                 break;
02154 
02155                         case AR_INT_SIZE_32:
02156                                 if (!IS_INT32_ZERO(result) &&
02157                                     (INT32_SIGN(opnd1) ^
02158                                      INT32_SIGN(opnd2) ^
02159                                      INT32_SIGN(result)))
02160                                         /* Nonzero result with wrong sign */
02161                                         status |= AR_STAT_OVERFLOW;
02162                                 break;
02163 
02164                         case AR_INT_SIZE_46:
02165                         case AR_INT_SIZE_64:
02166                                 if (!IS_INT64_ZERO(result) &&
02167                                     (INT64_SIGN(opnd1) ^
02168                                      INT64_SIGN(opnd2) ^
02169                                      INT64_SIGN(result)))
02170                                         /* Nonzero result with wrong sign */
02171                                         status |= AR_STAT_OVERFLOW;
02172                                 break;
02173 
02174                         default:
02175                                 return (AR_STAT_INVALID_TYPE);
02176                         }
02177                 }
02178 
02179                 return status |= AR_status ((AR_DATA*)result, resulttype);
02180         }
02181 
02182         if (AR_CLASS (*opnd1type) == AR_CLASS_FLOAT)
02183                 if (AR_FLOAT_IS_COMPLEX (*opnd1type) == AR_FLOAT_COMPLEX)
02184                         return ar_divide_complex (result, resulttype,
02185                                                   opnd1, opnd1type,
02186                                                   opnd2, opnd2type);
02187                 else
02188                         return ar_divide_float (result, resulttype,
02189                                                 opnd1, opnd1type,
02190                                                 opnd2, opnd2type);
02191 
02192         return AR_STAT_INVALID_TYPE;
02193 }
02194 
02195 /* Mod */
02196 int
02197 AR_modulo
02198                 (AR_DATA *result, const AR_TYPE *resulttype,
02199    const AR_DATA *opnd1,  const AR_TYPE *opnd1type,
02200    const AR_DATA *opnd2,  const AR_TYPE *opnd2type) {
02201 
02202         /* NOTE:
02203          * AR_modulo is to be removed when all usage has been changed to
02204          * AR_mod because 'modulo' is a Fortran 90 intrinsic which returns
02205          * different results than the Fortran 77 mod intrinsic.  This will
02206          * avoid future confusion and maintenance headaches (hopefully).
02207          * (AR_Modulo is currently the interface to the Fortran 90 intrinsic.)
02208          */
02209         return AR_mod(result, resulttype, opnd1, opnd1type, opnd2, opnd2type);
02210 }
02211 
02212 int
02213 AR_mod  (AR_DATA *res, const AR_TYPE *resulttype,
02214    const AR_DATA *op1, const AR_TYPE *opnd1type,
02215    const AR_DATA *op2, const AR_TYPE *opnd2type) {
02216 
02217         ar_data* result = (ar_data*)res;
02218         ar_data* opnd1  = (ar_data*)op1;
02219         ar_data* opnd2  = (ar_data*)op2;
02220 
02221         int status;
02222         ar_data divresult;
02223 
02224         if (*resulttype != *opnd1type ||
02225             *resulttype != *opnd2type ||
02226             AR_CLASS (*resulttype) != AR_CLASS_INT ||
02227             AR_INT_SIZE (*resulttype) != AR_INT_SIZE_8 &&
02228             AR_INT_SIZE (*resulttype) != AR_INT_SIZE_16 &&
02229             AR_INT_SIZE (*resulttype) != AR_INT_SIZE_32 &&
02230             AR_INT_SIZE (*resulttype) != AR_INT_SIZE_46 &&
02231             AR_INT_SIZE (*resulttype) != AR_INT_SIZE_64)
02232                 return AR_STAT_INVALID_TYPE;
02233 
02234         status = ar_divide_integer (&divresult, resulttype,
02235                                     result, resulttype,
02236                                     opnd1, opnd1type,
02237                                     opnd2, opnd2type);
02238 
02239         status |= AR_status ((AR_DATA*)result, resulttype);
02240 
02241         if (AR_SIGNEDNESS (*resulttype) == AR_SIGNED &&
02242             !(status & AR_STAT_ZERO)) {
02243                 switch (AR_INT_SIZE (*opnd1type)) {
02244                 case AR_INT_SIZE_8:
02245                         if (INT8_SIGN(result) ^ INT8_SIGN(opnd1))
02246                                 status |= AR_STAT_OVERFLOW;
02247                         break;
02248 
02249                 case AR_INT_SIZE_16:
02250                         if (INT16_SIGN(result) ^ INT16_SIGN(opnd1))
02251                                 status |= AR_STAT_OVERFLOW;
02252                         break;
02253 
02254                 case AR_INT_SIZE_32:
02255                         if (INT32_SIGN(result) ^ INT32_SIGN(opnd1))
02256                                 status |= AR_STAT_OVERFLOW;
02257                         break;
02258 
02259                 case AR_INT_SIZE_46:
02260                 case AR_INT_SIZE_64:
02261                         if (INT64_SIGN(result) ^ INT64_SIGN(opnd1))
02262                                 status |= AR_STAT_OVERFLOW;
02263                         break;
02264                 }
02265         }
02266 
02267         return status;
02268 }
02269 
02270 
02271 /* Pointer + integer computation */
02272 int
02273 AR_add_ptr_int
02274                 (AR_DATA *res, const AR_TYPE *resulttype,
02275    const AR_DATA *op1, const AR_TYPE *opnd1type,
02276    const AR_DATA *op2, const AR_TYPE *opnd2type,
02277    const AR_DATA *op3, const AR_TYPE *opnd3type) {
02278 
02279         ar_data* result = (ar_data*)res;
02280         ar_data* opnd1  = (ar_data*)op1;
02281         ar_data* opnd2  = (ar_data*)op2;
02282         ar_data* opnd3  = (ar_data*)op3;
02283 
02284         ar_data ptropnd, sizeopnd, intopnd, signextend;
02285         AR_TYPE sint64 = AR_Int_64_S;
02286         int status;
02287 
02288         if (*resulttype != *opnd1type ||
02289             AR_CLASS (*opnd1type) != AR_CLASS_POINTER ||
02290             AR_CLASS (*opnd2type) != AR_CLASS_INT ||
02291             AR_CLASS (*opnd3type) != AR_CLASS_INT ||
02292             AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_FCTN)
02293                 return AR_STAT_INVALID_TYPE;
02294 
02295         status = ar_convert_to_integral(&sizeopnd, &sint64, opnd2, opnd2type);
02296         if (status & ~AR_STAT_ZERO)
02297                 /* the bit offset must be representable as a
02298                    non-negative 64-bit signed int */
02299                 return AR_STAT_UNDEFINED;
02300 
02301         status = ar_convert_to_integral(&intopnd, &sint64, opnd3, opnd3type);
02302         status |= ar_multiply_integer(&intopnd, &sint64, &intopnd, &sint64,
02303                                                          &sizeopnd, &sint64);
02304 
02305         if (INT64_SIGN(&intopnd))
02306            signextend.ar_i64.part1 = signextend.ar_i64.part2 =
02307            signextend.ar_i64.part3 = signextend.ar_i64.part4 = 0xffff;
02308         else
02309            signextend.ar_i64.part1 = signextend.ar_i64.part2 =
02310            signextend.ar_i64.part3 = signextend.ar_i64.part4 = 0;
02311 
02312         if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_CHAR) {
02313                 /* Turn char pointer into byte pointer */
02314                 ar_dblshift(&ptropnd, &sint64, opnd1, opnd1, 128-3);
02315 
02316                 if (intopnd.ar_i64.part4 & 0x7)
02317                         /* bit offset must be mappable to a byte offset */
02318                         return AR_STAT_UNDEFINED;
02319 
02320                 /* turn the bit size into byte size */
02321                 ar_dblshift(&intopnd, &sint64, &signextend, &intopnd, 3);
02322         }
02323         else if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_WORD) {
02324                 ptropnd = *opnd1;
02325 
02326                 if (intopnd.ar_i64.part4 & 0x3f)
02327                         /* bit offset must be mappable to a word offset */
02328                         return AR_STAT_UNDEFINED;
02329 
02330                 /* turn the bit size into word size */
02331                 ar_dblshift(&intopnd, &sint64, &signextend, &intopnd, 6);
02332         }
02333         else {
02334                 ptropnd = *opnd1;
02335 
02336                 if (intopnd.ar_i64.part4 & 0x7)
02337                         /* bit offset must be mappable to a byte offset */
02338                         return AR_STAT_UNDEFINED;
02339 
02340                 /* turn the bit size into byte size */
02341                 ar_dblshift(&intopnd, &sint64, &signextend, &intopnd, 3);
02342         }
02343 
02344         status |= ar_add_integer(result, &sint64, &ptropnd, &sint64,
02345                                                   &intopnd, &sint64);
02346         
02347         if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_CHAR) {
02348                 /* Restore char pointer */
02349                 ar_dblshift (result, &sint64, result, result, 3);
02350         }
02351         else if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_WORD) {
02352                 if ((AR_POINTER_SIZE (*opnd1type) == AR_POINTER_64) &&
02353                     (result->ar_i64.part1 & 0xff00) != 0)
02354                         status |= AR_STAT_OVERFLOW;
02355                 else if ((AR_POINTER_SIZE (*opnd1type) == AR_POINTER_32) &&
02356                          (result->ar_i64.part1 != 0 ||
02357                           result->ar_i64.part2 != 0))
02358                         status |= AR_STAT_OVERFLOW;
02359                 else if ((AR_POINTER_SIZE (*opnd1type) == AR_POINTER_24) &&
02360                          (result->ar_i64.part1 != 0 ||
02361                           result->ar_i64.part2 != 0 ||
02362                           (result->ar_i64.part3 & 0xff00) != 0))
02363                         status |= AR_STAT_OVERFLOW;
02364         }
02365 
02366         ar_clear_unused_bits (result, resulttype);
02367     status = (status & AR_STAT_OVERFLOW) | AR_status((AR_DATA*)result, resulttype);
02368 
02369         return status;
02370 }
02371 
02372 
02373 /* Pointer - pointer computation */
02374 int
02375 AR_subtract_ptr_ptr
02376                 (AR_DATA *res, const AR_TYPE *resulttype,
02377    const AR_DATA *op1, const AR_TYPE *opnd1type,
02378    const AR_DATA *op2, const AR_TYPE *opnd2type,
02379    const AR_DATA *op3, const AR_TYPE *opnd3type) {
02380 
02381         ar_data* result = (ar_data*)res;
02382         ar_data* opnd1  = (ar_data*)op1;
02383         ar_data* opnd2  = (ar_data*)op2;
02384         ar_data* opnd3  = (ar_data*)op3;
02385 
02386         ar_data ptr1opnd, ptr2opnd, sizeopnd, modresult;
02387         AR_TYPE sint64 = AR_Int_64_S;
02388         int status;
02389 
02390         if (*opnd1type != *opnd3type ||
02391             AR_CLASS (*opnd1type) != AR_CLASS_POINTER ||
02392             AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_FCTN)
02393                 return AR_STAT_INVALID_TYPE;
02394 
02395         if (AR_CLASS (*opnd2type) != AR_CLASS_INT ||
02396             AR_CLASS (*resulttype) != AR_CLASS_INT)
02397                 return AR_STAT_INVALID_TYPE;
02398 
02399         status = ar_convert_to_integral(&sizeopnd, &sint64, opnd2, opnd2type);
02400         /* the bit offset must be representable as a non-negative 64-bit
02401            signed int */
02402         if (status & ~AR_STAT_ZERO)
02403                 return AR_STAT_UNDEFINED;
02404 
02405         if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_CHAR) {
02406                 /* Turn char pointers into byte pointers */
02407                 ar_dblshift(&ptr1opnd, &sint64, opnd1, opnd1, 128-3);
02408                 ar_dblshift(&ptr2opnd, &sint64, opnd3, opnd3, 128-3);
02409 
02410                 /* bit offset must be mappable to a byte offset */
02411                 if (sizeopnd.ar_i64.part4 & 0x7)
02412                         return AR_STAT_UNDEFINED;
02413         }
02414         else if (AR_POINTER_FORMAT (*opnd1type) == AR_POINTER_WORD) {
02415                 /* Turn word pointers into byte pointers */
02416                 ar_dblshift(&ptr1opnd, &sint64, (const ar_data*)&AR_const_zero, opnd1, 128-3);
02417                 ar_dblshift(&ptr2opnd, &sint64, (const ar_data*)&AR_const_zero, opnd3, 128-3);
02418 
02419                 /* bit offset must be mappable to a word offset */
02420                 if (sizeopnd.ar_i64.part4 & 0x3f)
02421                         return AR_STAT_UNDEFINED;
02422         }
02423         else {
02424                 ptr1opnd = *opnd1;
02425                 ptr2opnd = *opnd3;
02426 
02427                 /* bit offset must be mappable to a byte offset */
02428                 if (sizeopnd.ar_i64.part4 & 0x7)
02429                         return AR_STAT_UNDEFINED;
02430         }
02431 
02432         /* turn the bit size into byte size */
02433         ar_dblshift(&sizeopnd, &sint64, (const ar_data*)&AR_const_zero, &sizeopnd, 3);
02434 
02435         status = ar_subtract_integer(result, &sint64, (int *)0,
02436                                      &ptr1opnd, &sint64, &ptr2opnd, &sint64);
02437         status &= AR_STAT_OVERFLOW;  /* keep only the overflow flag */
02438         status |= ar_divide_integer(result, &sint64, &modresult, &sint64,
02439                                     result, &sint64, &sizeopnd, &sint64);
02440 
02441         if (modresult.ar_i64.part1 | modresult.ar_i64.part2 |
02442             modresult.ar_i64.part3 | modresult.ar_i64.part4) {
02443                  status |= AR_STAT_INEXACT;
02444         }
02445 
02446         return status;
02447 }
02448 
02449 
02450 static char USMID [] = "\n%Z%%M%        %I%     %G% %U%\n";
02451 static char rcsid [] = "$Id: math.c,v 1.1.1.1 2002-05-22 20:06:19 dsystem Exp $";
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Defines