test_ar_intrin.c

Go to the documentation of this file.

/*

  Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.

  This program is free software; you can redistribute it and/or modify it
  under the terms of version 2 of the GNU General Public License as
  published by the Free Software Foundation.

  This program is distributed in the hope that it would be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  

  Further, this software is distributed without any warranty that it is
  free of the rightful claim of any third person regarding infringement 
  or the like.  Any license provided herein, whether implied or 
  otherwise, applies only to this software file.  Patent licenses, if 
  any, provided herein do not apply to combinations of this program with 
  other software, or any other product whatsoever.  

  You should have received a copy of the GNU General Public License along
  with this program; if not, write the Free Software Foundation, Inc., 59
  Temple Place - Suite 330, Boston MA 02111-1307, USA.

  Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
  Mountain View, CA 94043, or:

  http://www.sgi.com

  For further information regarding this notice, see:

  http://oss.sgi.com/projects/GenInfo/NoticeExplan

*/

#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>

#if defined(_LINUX_LINUX)
# define HAVE_FORTRAN_H
# include <fortran.h>
#endif

#include "arith.h"

static int                      pass = 0;
static int                      fail = 0;

static AR_HOST_SINT64           result[4];

static void                     check_ar_result();

static char                     prevfname[8];
static int                      prevflen;

#if defined(CRAY_TS_IEEE)
  static AR_TYPE                INT_TYPE = AR_Int_64_S;
  static AR_TYPE                FLOAT_64 = AR_Float_IEEE_NR_64;
  static AR_TYPE                FLOAT_128 = AR_Float_IEEE_NR_128;
  static AR_TYPE                COMPLEX_64 = AR_Complex_IEEE_NR_64;
  static AR_TYPE                COMPLEX_128 = AR_Complex_IEEE_NR_128;
#elif _CRAY
  static AR_TYPE                INT_TYPE = AR_Int_64_S;
  static AR_TYPE                FLOAT_64 = AR_Float_Cray1_64;
  static AR_TYPE                FLOAT_128 = AR_Float_Cray1_128;
  static AR_TYPE                COMPLEX_64 = AR_Complex_Cray1_64;
  static AR_TYPE                COMPLEX_128 = AR_Complex_Cray1_128;
#else
  static AR_TYPE                INT_TYPE = AR_Int_64_S;
  static AR_TYPE                FLOAT_64 = AR_Float_IEEE_NR_64;
  static AR_TYPE                FLOAT_128 = AR_Float_IEEE_NR_128;
  static AR_TYPE                COMPLEX_64 = AR_Complex_IEEE_NR_64;
  static AR_TYPE                COMPLEX_128 = AR_Complex_IEEE_NR_128;
#endif


int main()
{
  prevflen = 0;

#if !defined(HAVE_FORTRAN_H)
  test_native_();
#else
  TEST_NATIVE();
#endif
  printf("Intrinsic test results:\n%6d passed\n%6d FAILED!!!\n",pass,fail);
  exit(fail);
  return 0; /* not reached */
}

#if !defined(HAVE_FORTRAN_H)
void ar_strtod_(answer)
#else
void AR_STRTOD(answer)
#endif
     double*    answer;
{
  char  num[32];
  
  double        dval;
  
  int           ierr;
  AR_TYPE       rtype;
  
  if(*answer >= 1.e6)
    sprintf(num,"%22.14e",*answer);
  else if(*answer >= 0.)
    sprintf(num,"%15.8f",*answer);
  else if(*answer >= -1.e6)
    sprintf(num,"%15.4f",*answer);
  else
    sprintf(num,"%25.16e",*answer);
  
  dval = strtod(num, 0);
  
  rtype = FLOAT_64;
  
  ierr = AR_convert_str_to_float((AR_DATA*)&result[0], &rtype, num);
  
  check_ar_result("STRTOD", strlen("STRTOD"), &result[0], ierr, &dval, 1);
}

#ifdef LD
#if !defined(HAVE_FORTRAN_H)
void ar_strtold_(answer)
#else
void AR_STRTOLD(answer)
#endif
     long double*       answer;
{
  char          num[33];
  
  long double   ldval;

  int                   ierr;
  AR_TYPE               rtype;
  
#if !defined(HAVE_FORTRAN_H)
  if(*answer >= 1.e6L)
    sprintf(num,"%30.22Le",*answer);
  else if(*answer >= 0.)
    sprintf(num,"%20.12Lf",*answer);
  else if(*answer >= -1.e6L)
    sprintf(num,"%22.10Lf",*answer);
  else
    sprintf(num,"%31.23Le",*answer);
  sscanf(num," %Lf", &ldval);
#else
  if(*answer >= 1.e6L)
    sprintf(num,"%30.22e",*answer);
  else if(*answer >= 0.)
    sprintf(num,"%20.12f",*answer);
  else if(*answer >= -1.e6L)
    sprintf(num,"%22.10f",*answer);
  else
    sprintf(num,"%31.23e",*answer);
  ldval = strtold(num, 0);
#endif
  
  rtype = FLOAT_128;
  
  ierr = AR_convert_str_to_float((AR_DATA*)&result[0], &rtype, num);
  
  check_ar_result("STRTOLD", strlen("STRTOLD"), &result[0], ierr, &ldval, 2);
}
#endif


#if !defined(HAVE_FORTRAN_H)
void ar_intrin1_(func, opnd, answer, func_len)
     char*                      func;
     AR_DATA*                   opnd;
     AR_DATA*                   answer;
     int                        func_len;
#else
void AR_INTRIN1(func, opnd, answer)
     _fcd                       func;
     AR_DATA*                   opnd;
     AR_DATA*                   answer;
#endif
{
  int                           ierr;
  int                           n;
  AR_TYPE                       rtype,otype,ptype;
  
#if !defined(HAVE_FORTRAN_H)
  char                  *fname = func;
  int                   flen   = func_len;
#else
  char                  *fname = _fcdtocp(func);
  int                   flen   = _fcdlen(func);
#endif
  
  n = 1;

  if(strncmp(&fname[flen-3],"LOG",3) == 0) {
    if(fname[0] == 'A')
      rtype = FLOAT_64;
    else if(fname[0] == 'D') {
      rtype = FLOAT_128;
      n = 2;
    }
    else if(fname[1] == 'L') {
      rtype = COMPLEX_64;
      n = 2;
    }
    else {
      rtype = COMPLEX_128;
      n = 4;
    }
    ierr = AR_log((AR_DATA*)&result[0], &rtype, opnd, &rtype);
  }
  
  else if(strncmp(&fname[flen-3],"EXP",3) == 0) {
    if(fname[0] == 'E')
      rtype = FLOAT_64;
    else if(fname[0] == 'D') {
      rtype = FLOAT_128;
      n = 2;
    }
    else if(fname[1] == 'E') {
      rtype = COMPLEX_64;
      n = 2;
    }
    else {
      rtype = COMPLEX_128;
      n = 4;
    }
    ierr = AR_exp((AR_DATA*)&result[0], &rtype, opnd, &rtype);
  }
  
  else if(strncmp(&fname[flen-4],"SQRT",4) == 0) {
    if(fname[0] == 'S')
      rtype = FLOAT_64;
    else if(fname[0] == 'D') {
      rtype = FLOAT_128;
      n = 2;
    }
    else if(fname[1] == 'S') {
      rtype = COMPLEX_64;
      n = 2;
    }
    else {
      rtype = COMPLEX_128;
      n = 4;
    }
    ierr = AR_sqrt((AR_DATA*)&result[0], &rtype, opnd, &rtype);
  }
  
  else if(strncmp(&fname[flen-3],"ABS",3) == 0) {
    if(fname[1] == 'A') {
      rtype = FLOAT_64;
      otype = COMPLEX_64;
    }
    else {
      rtype = FLOAT_128;
      otype = COMPLEX_128;
      n = 2;
    }
    ierr = AR_cabs((AR_DATA*)&result[0], &rtype, opnd, &otype);
  }
  
  check_ar_result(fname, flen, &result[0], ierr, answer, n);
}

#if !defined(HAVE_FORTRAN_H)
void ar_intrin2_(func, opnd1, opnd2, answer, func_len)
     char*                      func;
     AR_DATA*                   opnd1;
     AR_DATA*                   opnd2;
     AR_DATA*                   answer;
     int                        func_len;
#else
     void AR_INTRIN2(func, opnd1, opnd2, answer)
     _fcd                       func;
     AR_DATA*                   opnd1;
     AR_DATA*                   opnd2;
     AR_DATA*                   answer;
#endif
{
  int                   ierr;
  int                   n;
  AR_TYPE                       rtype,otype,ptype;
  AR_HOST_SINT64        base,power;

#if !defined(HAVE_FORTRAN_H)
  char                  *fname = func;
  int                   flen   = func_len;
#else
  char                  *fname = _fcdtocp(func);
  int                   flen   = _fcdlen(func);
#endif
  
  n = 1;
  
  base = power = 0;
  if(strncmp(&fname[flen-3],"TOI",3)==0 ||
     strncmp(&fname[flen-3],"TOR",3)==0) {
    if(fname[0] == 'I') {
#if _CRAY
      rtype = AR_Int_64_S;
      otype = AR_Int_64_S;
#else
      memcpy(((char*)&base)+4, ((char*)opnd1)+4, 4);
      memcpy(((char*)&power)+4, ((char*)opnd2)+4, 4);
      if((base>>31)  != 0 || (power>>31) != 0) {
        if((base>>31)  != 0)
          memset((char*)opnd1, 0xff, 4);
        if((power>>31) != 0)
          memset((char*)opnd2, 0xff, 4);
        rtype = AR_Int_64_S;
        otype = AR_Int_64_S;
      }
      else {
        rtype = AR_Int_32_S;
        otype = AR_Int_32_S;
      }
#endif
    }
    else if(fname[0] == 'R') {
      rtype = FLOAT_64;
      otype = FLOAT_64;
    }
    else if(fname[0] == 'D') {
      rtype = FLOAT_128;
      otype = FLOAT_128;
      n = 2;
    }
    else if(fname[1] == 'T') {
      rtype = COMPLEX_64;
      otype = COMPLEX_64;
      n = 2;
    }
    else {
      rtype = COMPLEX_128;
      otype = COMPLEX_128;
      n = 4;
    }
    if(fname[flen-1] == 'I') {
#if _CRAY
      ptype = AR_Int_64_S;
#else
      memcpy(((char*)&power)+4, ((char*)opnd2)+4, 4);
      if(otype == AR_Int_64_S || (power>>31) != 0) {
        if((power>>31) != 0)
          memset((char*)opnd2, 0xff, 4);
        ptype = AR_Int_64_S;
      }
      else
        ptype = AR_Int_32_S;
#endif
    }
    else
      ptype = FLOAT_64;
    ierr = AR_power((AR_DATA*)&result[0], &rtype, opnd1, &otype, opnd2,
                    &ptype);
    if(base != 0) {
      memset((char*)opnd1, 0, 4);
      if(rtype == AR_Int_64_S && (power&1))
        memset((char*)&result[0], 0, 4);
    }
    if(power != 0)
      memset((char*)opnd2, 0, 4);
  }
  else {
    if(fname[0] == 'D') {
      rtype = FLOAT_128;
      otype = FLOAT_128;
      ptype = FLOAT_128;
      n = 2;
    }
    else if(fname[1] == 'T') {
      rtype = COMPLEX_64;
      otype = COMPLEX_64;
      ptype = COMPLEX_64;
      n = 2;
    }
    else {
      rtype = COMPLEX_128;
      otype = COMPLEX_128;
      ptype = COMPLEX_128;
      n = 4;
    }
    ierr = AR_power((AR_DATA*)&result[0], &rtype, opnd1, &otype, opnd2,
                    &ptype);
  }
  
  check_ar_result(fname, flen, &result[0], ierr, answer, n);
}

static
void
check_ar_result(fname, flen, ar_result, ar_error, answer, rsize)
     char               *fname;
     int                flen;
     AR_HOST_SINT64     *ar_result;
     int                ar_error;
     AR_HOST_SINT64     *answer;
     int                rsize;
{
  int           i;
  int           ierr;
  AR_HOST_SINT64        xor;
  
  if(prevflen != flen && strncmp(prevfname, fname, flen) != 0) {
    prevflen = flen;
    strncpy(prevfname, fname, flen);
    printf("Testing %*.*s intrinsic\n", flen, flen, fname);
  }
  
  ierr = ar_error&(AR_STAT_OVERFLOW|AR_STAT_UNDEFINED|AR_STAT_INVALID_TYPE);
  
  for(xor=0, i=0; i<rsize; i++)
    xor |= (ar_result[i]^answer[i]);
  
  if((ierr & (AR_STAT_OVERFLOW|AR_STAT_UNDEFINED)) &&
     ((answer[0]>>52)&0x7ff) == 0x7ff) ierr=0;
  
  if(ierr!=0 || xor!=0) {
    const char* conversion = NULL;

    fprintf(stderr,
            "\n***** ERROR *** ERROR *** ERROR *** ERROR *****\n");
    fprintf(stderr,
            "   arith.a %*.*s result does not match expected result of",
            flen, flen, fname);
    
#ifdef _CRAY /* see arith.h */
    conversion = " %8.8lx";
#else
    conversion = " %8.8llx";
#endif
      
    for(i=0; i<rsize; i++)
      fprintf(stderr, conversion, (AR_HOST_UINT64)answer[i]);
    fprintf(stderr,"\n");
    if(ierr != 0)
      fprintf(stderr,
              "   The arith.a routine returned an error code = 0%o\n",
              ierr);
    else {
      fprintf(stderr,"   The arith.a routine returned a result of");
      for(i=0; i<rsize; i++)
        fprintf(stderr, conversion, (AR_HOST_UINT64)ar_result[i]);
      fprintf(stderr,"\n");
    }
    fail++;
  }
  else
    pass++;
  
}


static char USMID [] = "\n%Z%%M%        %I%     %G% %U%\n";
static char rcsid [] = "$Id: test_ar_intrin.c,v 1.4 2003-12-11 22:08:33 eraxxon Exp $";