00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039 #include <stdio.h>
00040 #include <stdlib.h>
00041 #include <string.h>
00042 #include <ctype.h>
00043
00044 #if !defined(__sparc__) && !defined(__mips)
00045 # include <fortran.h>
00046 #endif
00047
00048 #include "arith.h"
00049
00050 static int pass = 0;
00051 static int fail = 0;
00052
00053 static AR_HOST_SINT64 result[4];
00054
00055 static void check_ar_result();
00056
00057 static char prevfname[8];
00058 static int prevflen;
00059
00060 #if defined(CRAY_TS_IEEE)
00061 static AR_TYPE INT_TYPE = AR_Int_64_S;
00062 static AR_TYPE FLOAT_64 = AR_Float_IEEE_NR_64;
00063 static AR_TYPE FLOAT_128 = AR_Float_IEEE_NR_128;
00064 static AR_TYPE COMPLEX_64 = AR_Complex_IEEE_NR_64;
00065 static AR_TYPE COMPLEX_128 = AR_Complex_IEEE_NR_128;
00066 #elif _CRAY
00067 static AR_TYPE INT_TYPE = AR_Int_64_S;
00068 static AR_TYPE FLOAT_64 = AR_Float_Cray1_64;
00069 static AR_TYPE FLOAT_128 = AR_Float_Cray1_128;
00070 static AR_TYPE COMPLEX_64 = AR_Complex_Cray1_64;
00071 static AR_TYPE COMPLEX_128 = AR_Complex_Cray1_128;
00072 #else
00073 static AR_TYPE INT_TYPE = AR_Int_64_S;
00074 static AR_TYPE FLOAT_64 = AR_Float_IEEE_NR_64;
00075 static AR_TYPE FLOAT_128 = AR_Float_IEEE_NR_128;
00076 static AR_TYPE COMPLEX_64 = AR_Complex_IEEE_NR_64;
00077 static AR_TYPE COMPLEX_128 = AR_Complex_IEEE_NR_128;
00078 #endif
00079
00080
00081 int main(int argc, char **argv)
00082 {
00083 prevflen = 0;
00084
00085 #if defined(__sparc__) || defined(__mips)
00086 extern void test_native_();
00087 test_native_();
00088 #else
00089 TEST_NATIVE();
00090 #endif
00091 printf("Intrinsic test results:\n%6d passed\n%6d FAILED!!!\n",pass,fail);
00092 exit(fail);
00093 }
00094
00095 #if defined(__sparc__) || defined(__mips)
00096 void ar_strtod_(answer)
00097 #else
00098 void AR_STRTOD(answer)
00099 #endif
00100 double* answer;
00101 {
00102 char num[32];
00103
00104 double dval;
00105
00106 int ierr;
00107 AR_TYPE rtype;
00108
00109 if(*answer >= 1.e6)
00110 sprintf(num,"%22.14e",*answer);
00111 else if(*answer >= 0.)
00112 sprintf(num,"%15.8f",*answer);
00113 else if(*answer >= -1.e6)
00114 sprintf(num,"%15.4f",*answer);
00115 else
00116 sprintf(num,"%25.16e",*answer);
00117
00118 dval = strtod(num, 0);
00119
00120 rtype = FLOAT_64;
00121
00122 ierr = AR_convert_str_to_float((AR_DATA*)&result[0], &rtype, num);
00123
00124 check_ar_result("STRTOD", strlen("STRTOD"), &result[0], ierr, &dval, 1);
00125 }
00126
00127 #ifdef LD
00128 #if defined(__sparc__) || defined(__mips)
00129 void ar_strtold_(answer)
00130 #else
00131 void AR_STRTOLD(answer)
00132 #endif
00133 long double* answer;
00134 {
00135 char num[33];
00136
00137 long double ldval;
00138
00139 int ierr;
00140 AR_TYPE rtype;
00141
00142 #if defined(__sparc__) || defined(__mips)
00143 if(*answer >= 1.e6L)
00144 sprintf(num,"%30.22Le",*answer);
00145 else if(*answer >= 0.)
00146 sprintf(num,"%20.12Lf",*answer);
00147 else if(*answer >= -1.e6L)
00148 sprintf(num,"%22.10Lf",*answer);
00149 else
00150 sprintf(num,"%31.23Le",*answer);
00151 sscanf(num," %Lf", &ldval);
00152 #else
00153 if(*answer >= 1.e6L)
00154 sprintf(num,"%30.22e",*answer);
00155 else if(*answer >= 0.)
00156 sprintf(num,"%20.12f",*answer);
00157 else if(*answer >= -1.e6L)
00158 sprintf(num,"%22.10f",*answer);
00159 else
00160 sprintf(num,"%31.23e",*answer);
00161 ldval = strtold(num, 0);
00162 #endif
00163
00164 rtype = FLOAT_128;
00165
00166 ierr = AR_convert_str_to_float((AR_DATA*)&result[0], &rtype, num);
00167
00168 check_ar_result("STRTOLD", strlen("STRTOLD"), &result[0], ierr, &ldval, 2);
00169 }
00170 #endif
00171
00172
00173 #if defined(__sparc__) || defined(__mips)
00174 void ar_intrin1_(func, opnd, answer, func_len)
00175 char* func;
00176 AR_DATA* opnd;
00177 AR_DATA* answer;
00178 int func_len;
00179 #else
00180 void AR_INTRIN1(func, opnd, answer)
00181 _fcd func;
00182 AR_DATA* opnd;
00183 AR_DATA* answer;
00184 #endif
00185 {
00186 int ierr;
00187 int n;
00188 AR_TYPE rtype,otype,ptype;
00189
00190 #if defined(__sparc__) || defined(__mips)
00191 char *fname = func;
00192 int flen = func_len;
00193 #else
00194 char *fname = _fcdtocp(func);
00195 int flen = _fcdlen(func);
00196 #endif
00197
00198 n = 1;
00199
00200 if(strncmp(&fname[flen-3],"LOG",3) == 0) {
00201 if(fname[0] == 'A')
00202 rtype = FLOAT_64;
00203 else if(fname[0] == 'D') {
00204 rtype = FLOAT_128;
00205 n = 2;
00206 }
00207 else if(fname[1] == 'L') {
00208 rtype = COMPLEX_64;
00209 n = 2;
00210 }
00211 else {
00212 rtype = COMPLEX_128;
00213 n = 4;
00214 }
00215 ierr = AR_log((AR_DATA*)&result[0], &rtype, opnd, &rtype);
00216 }
00217
00218 else if(strncmp(&fname[flen-3],"EXP",3) == 0) {
00219 if(fname[0] == 'E')
00220 rtype = FLOAT_64;
00221 else if(fname[0] == 'D') {
00222 rtype = FLOAT_128;
00223 n = 2;
00224 }
00225 else if(fname[1] == 'E') {
00226 rtype = COMPLEX_64;
00227 n = 2;
00228 }
00229 else {
00230 rtype = COMPLEX_128;
00231 n = 4;
00232 }
00233 ierr = AR_exp((AR_DATA*)&result[0], &rtype, opnd, &rtype);
00234 }
00235
00236 else if(strncmp(&fname[flen-4],"SQRT",4) == 0) {
00237 if(fname[0] == 'S')
00238 rtype = FLOAT_64;
00239 else if(fname[0] == 'D') {
00240 rtype = FLOAT_128;
00241 n = 2;
00242 }
00243 else if(fname[1] == 'S') {
00244 rtype = COMPLEX_64;
00245 n = 2;
00246 }
00247 else {
00248 rtype = COMPLEX_128;
00249 n = 4;
00250 }
00251 ierr = AR_sqrt((AR_DATA*)&result[0], &rtype, opnd, &rtype);
00252 }
00253
00254 else if(strncmp(&fname[flen-3],"ABS",3) == 0) {
00255 if(fname[1] == 'A') {
00256 rtype = FLOAT_64;
00257 otype = COMPLEX_64;
00258 }
00259 else {
00260 rtype = FLOAT_128;
00261 otype = COMPLEX_128;
00262 n = 2;
00263 }
00264 ierr = AR_cabs((AR_DATA*)&result[0], &rtype, opnd, &otype);
00265 }
00266
00267 check_ar_result(fname, flen, &result[0], ierr, answer, n);
00268 }
00269
00270 #if defined(__sparc__) || defined(__mips)
00271 void ar_intrin2_(func, opnd1, opnd2, answer, func_len)
00272 char* func;
00273 AR_DATA* opnd1;
00274 AR_DATA* opnd2;
00275 AR_DATA* answer;
00276 int func_len;
00277 #else
00278 void AR_INTRIN2(func, opnd1, opnd2, answer)
00279 _fcd func;
00280 AR_DATA* opnd1;
00281 AR_DATA* opnd2;
00282 AR_DATA* answer;
00283 #endif
00284 {
00285 int ierr;
00286 int n;
00287 AR_TYPE rtype,otype,ptype;
00288 AR_HOST_SINT64 base,power;
00289
00290 #if defined(__sparc__) || defined(__mips)
00291 char *fname = func;
00292 int flen = func_len;
00293 #else
00294 char *fname = _fcdtocp(func);
00295 int flen = _fcdlen(func);
00296 #endif
00297
00298 n = 1;
00299
00300 base = power = 0;
00301 if(strncmp(&fname[flen-3],"TOI",3)==0 ||
00302 strncmp(&fname[flen-3],"TOR",3)==0) {
00303 if(fname[0] == 'I') {
00304 #if _CRAY
00305 rtype = AR_Int_64_S;
00306 otype = AR_Int_64_S;
00307 #else
00308 memcpy(((char*)&base)+4, ((char*)opnd1)+4, 4);
00309 memcpy(((char*)&power)+4, ((char*)opnd2)+4, 4);
00310 if((base>>31) != 0 || (power>>31) != 0) {
00311 if((base>>31) != 0)
00312 memset((char*)opnd1, 0xff, 4);
00313 if((power>>31) != 0)
00314 memset((char*)opnd2, 0xff, 4);
00315 rtype = AR_Int_64_S;
00316 otype = AR_Int_64_S;
00317 }
00318 else {
00319 rtype = AR_Int_32_S;
00320 otype = AR_Int_32_S;
00321 }
00322 #endif
00323 }
00324 else if(fname[0] == 'R') {
00325 rtype = FLOAT_64;
00326 otype = FLOAT_64;
00327 }
00328 else if(fname[0] == 'D') {
00329 rtype = FLOAT_128;
00330 otype = FLOAT_128;
00331 n = 2;
00332 }
00333 else if(fname[1] == 'T') {
00334 rtype = COMPLEX_64;
00335 otype = COMPLEX_64;
00336 n = 2;
00337 }
00338 else {
00339 rtype = COMPLEX_128;
00340 otype = COMPLEX_128;
00341 n = 4;
00342 }
00343 if(fname[flen-1] == 'I') {
00344 #if _CRAY
00345 ptype = AR_Int_64_S;
00346 #else
00347 memcpy(((char*)&power)+4, ((char*)opnd2)+4, 4);
00348 if(otype == AR_Int_64_S || (power>>31) != 0) {
00349 if((power>>31) != 0)
00350 memset((char*)opnd2, 0xff, 4);
00351 ptype = AR_Int_64_S;
00352 }
00353 else
00354 ptype = AR_Int_32_S;
00355 #endif
00356 }
00357 else
00358 ptype = FLOAT_64;
00359 ierr = AR_power((AR_DATA*)&result[0], &rtype, opnd1, &otype, opnd2,
00360 &ptype);
00361 if(base != 0) {
00362 memset((char*)opnd1, 0, 4);
00363 if(rtype == AR_Int_64_S && (power&1))
00364 memset((char*)&result[0], 0, 4);
00365 }
00366 if(power != 0)
00367 memset((char*)opnd2, 0, 4);
00368 }
00369 else {
00370 if(fname[0] == 'D') {
00371 rtype = FLOAT_128;
00372 otype = FLOAT_128;
00373 ptype = FLOAT_128;
00374 n = 2;
00375 }
00376 else if(fname[1] == 'T') {
00377 rtype = COMPLEX_64;
00378 otype = COMPLEX_64;
00379 ptype = COMPLEX_64;
00380 n = 2;
00381 }
00382 else {
00383 rtype = COMPLEX_128;
00384 otype = COMPLEX_128;
00385 ptype = COMPLEX_128;
00386 n = 4;
00387 }
00388 ierr = AR_power((AR_DATA*)&result[0], &rtype, opnd1, &otype, opnd2,
00389 &ptype);
00390 }
00391
00392 check_ar_result(fname, flen, &result[0], ierr, answer, n);
00393 }
00394
00395 static
00396 void
00397 check_ar_result(fname, flen, ar_result, ar_error, answer, rsize)
00398 char *fname;
00399 int flen;
00400 AR_HOST_SINT64 *ar_result;
00401 int ar_error;
00402 AR_HOST_SINT64 *answer;
00403 int rsize;
00404 {
00405 int i;
00406 int ierr;
00407 AR_HOST_SINT64 xor;
00408
00409 if(prevflen != flen && strncmp(prevfname, fname, flen) != 0) {
00410 prevflen = flen;
00411 strncpy(prevfname, fname, flen);
00412 printf("Testing %*.*s intrinsic\n", flen, flen, fname);
00413 }
00414
00415 ierr = ar_error&(AR_STAT_OVERFLOW|AR_STAT_UNDEFINED|AR_STAT_INVALID_TYPE);
00416
00417 for(xor=0, i=0; i<rsize; i++)
00418 xor |= (ar_result[i]^answer[i]);
00419
00420 if((ierr & (AR_STAT_OVERFLOW|AR_STAT_UNDEFINED)) &&
00421 ((answer[0]>>52)&0x7ff) == 0x7ff) ierr=0;
00422
00423 if(ierr!=0 || xor!=0) {
00424 fprintf(stderr,
00425 "\n***** ERROR *** ERROR *** ERROR *** ERROR *****\n");
00426 fprintf(stderr,
00427 " arith.a %*.*s result does not match expected result of",
00428 flen, flen, fname);
00429 for(i=0; i<rsize; i++)
00430 fprintf(stderr," %16.16llx",answer[i]);
00431 fprintf(stderr,"\n");
00432 if(ierr != 0)
00433 fprintf(stderr,
00434 " The arith.a routine returned an error code = 0%o\n",
00435 ierr);
00436 else {
00437 fprintf(stderr," The arith.a routine returned a result of");
00438 for(i=0; i<rsize; i++)
00439 fprintf(stderr," %16.16llx",ar_result[i]);
00440 fprintf(stderr,"\n");
00441 }
00442 fail++;
00443 }
00444 else
00445 pass++;
00446
00447 }
00448
00449
00450 static char USMID [] = "\n%Z%%M% %I% %G% %U%\n";
00451 static char rcsid [] = "$Id: test_ar_intrin.c,v 1.1.1.1 2005/10/21 19:00:00 marcel Exp $";
