コード例 #1
0
void
NAME(DopeVectorType *RESULT, DopeVectorType *MATRIX_A,
     DopeVectorType *MATRIX_B)
{
    void    SUBNAME();
    const RESULTTYPE   true =  _btol(1);
    const RESULTTYPE   false = _btol(0);
    MatrixDimenType matdimdata, *MATDIM;

        MATDIM = (MatrixDimenType *) &matdimdata;

    /*
     * Parse dope vectors, and perform error checking.
     */

    _premult(RESULT, MATRIX_A, MATRIX_B, MATDIM);

    /*
     * Perform the matrix multiplication.
     */

    SUBNAME(&MATDIM->m, &MATDIM->n, &MATDIM->k, &true, MATDIM->A,
         &MATDIM->inc1a, &MATDIM->inc2a, MATDIM->B, &MATDIM->inc1b,
         &MATDIM->inc2b, &false, MATDIM->C, &MATDIM->inc1c, &MATDIM->inc2c);
     return;
}
コード例 #2
0
ファイル: eoshift_p_wd2_3.c プロジェクト: sharugupta/OpenUH
void
_EOSHIFT_CP3 (
		DopeVectorType  *result,
		DopeVectorType  *source,
		DopeVectorType  *shift,
		DopeVectorType  *boundary,
		int		*dim)

{
#include "eoshift_p.h"

/*
 *      Call the Fortran work routine
 */

	special = 0;
	if (shflag == _btol(1) && bndflag == _btol(1)) {
	    if (shftval >= -1 && shftval <= 1) {
		if (_blkct (source_sdd_ptr, 1, 0) == 1 &&
		    _blkct (source_sdd_ptr, 2, 0) == 1 &&
		    _blkct (source_sdd_ptr, 3, 0) == 1) {
		    special = 1;
		}
	    }
	}

	if (special) {
	    EOSHIFT_SPEC_WD2_P3@ ( result_sdd_ptr, source_sdd_ptr,
		&dim_val, src_extents, &shftval, &bndval);
	} else {
	    EOSHIFT_WD2_P3@ ( result_sdd_ptr, source_sdd_ptr, shift_sdd_ptr,
		bound_sdd_ptr, &dim_val, src_extents, shft_extents,
		bnd_extents, &shflag, &shftval, &bndflag, &bndval);
	}
}
コード例 #3
0
ファイル: pre_sum.c プロジェクト: sharugupta/OpenUH
void
_PRE_SUM(int *flag, DopeVectorType * RESULT, DopeVectorType * MATRIX_A,
	DopeVectorType *DIM, DopeVectorType * MASK, int *ndim,
	int *dimarg, int *dima, int *maskarg, int *scalar, long *loca,
	int lima[], int inca[], long *locb,
	int limb[], int incb[], long *locm,
	int limm[], int incm[], int *sizem, long *loc4m)
{
	int	nbits, nbytes, nwords;	/* size of RESULT matrix */
	int	i;		/* subscript */
	int	dim;		/* value of DIM argument */
	int	temp;		/* for temporary storage */
	void	*locab;		/* local store for veca */
	void	*locbb;		/* local store for vecb */
	void	*locmc;		/* local store for result */
	DopeVectorType	*dm, *mk;
	_f_int8 *dimenp8	= NULL;
	_f_int4 *dimenp4	= NULL;
	_f_int2 *dimenp2	= NULL;
	_f_int1 *dimenp1	= NULL;
	int	dmintlen;	/* internal length of DIM value */
	dm = DIM;
	mk = MASK;
	/* if last arg = NULL, is last-1 arg mask or dim? */
	if (MASK == NULL) {
		/* last arg = NULL, is last-1 arg mask or dim? */
		if (DIM != NULL) {
			if (DIM->type_lens.type == DVTYPE_LOGICAL) {
				/* last-1 argument is mask. */
				mk = DIM;
				dm = MASK;
			}
		}
	}
	if (dm != NULL) {
		dmintlen = dm->type_lens.int_len >> 3;
		if (dmintlen == sizeof(_f_int8)) {
			*dimarg	= _btol(1);     /* dimarg = .TRUE. */
			dimenp8	= (_f_int8 *) dm->base_addr.a.ptr;
			dim	= *dimenp8;     /* dimension to sum over */
			*dima	= *dimenp8;     /* dimension to sum over */
		} else if (dmintlen == sizeof(_f_int4)) {
			*dimarg	= _btol(1);     /* dimarg = .TRUE. */
			dimenp4	= (_f_int4 *) dm->base_addr.a.ptr;
			dim	= *dimenp4;     /* dimension to sum over */
			*dima	= *dimenp4;     /* dimension to sum over */
		} else if (dmintlen == sizeof(_f_int2)) {
			*dimarg	= _btol(1);     /* dimarg = .TRUE. */
			dimenp2	= (_f_int2 *) dm->base_addr.a.ptr;
			dim	= *dimenp2;     /* dimension to sum over */
			*dima	= *dimenp2;     /* dimension to sum over */
		} else if (dmintlen == sizeof(_f_int1)) {
			*dimarg	= _btol(1);     /* dimarg = .TRUE. */
			dimenp1	= (_f_int1 *) dm->base_addr.a.ptr;
			dim	= *dimenp1;     /* dimension to sum over */
			*dima	= *dimenp1;     /* dimension to sum over */
		}
	} else {
コード例 #4
0
void
_CSHIFT_JP1 (
		DopeVectorType  *result,
		DopeVectorType  *source,
		DopeVectorType  *shift,
		int		*dim)

{
#include "cshift_p.h"

/*
 *      Call the Fortran work routine
 */

	special = 0;
	if (shflag == _btol(1)) {
	    if (shftval >= -1 && shftval <= 1) {
		if (_blkct (source_sdd_ptr, 1, 0) == 1) {
		    special = 1;
		}
	    }
	}

	if (special) {
	    CSHIFT_SPEC_WD1_P1@ ( result_sdd_ptr, source_sdd_ptr,
		src_extents, &shftval);
	} else {
	    CSHIFT_WD1_P1@ ( result_sdd_ptr, source_sdd_ptr, src_extents,
		&shftval);
	}
}
コード例 #5
0
ファイル: allocated.c プロジェクト: manojxantony/compiler
_f_log8
_ALLOCATED_8 (DopeVectorType * source)
{

	_f_log8 iresult;
	iresult = FALSE;
	/* Is source is an allocatable array and allocated. */
	if ((source->p_or_a == ALLOC_ARRY) && (source->assoc))
		iresult = TRUE;
        return(_btol(iresult));
}
コード例 #6
0
ファイル: ieee_is_nan_h.c プロジェクト: xyuan/Path64
_f_log8 _IEEE_IS_NAN_L8_H( _f_real4 x)
{
	/* if x is NaN, return TRUE */
	return ((_f_log8) _btol(isnan32(x)));
}
コード例 #7
0
ファイル: ieee_is_nan_d.c プロジェクト: sharugupta/OpenUH
_f_log8 _IEEE_IS_NAN_L8_D( _f_real16 x)
{
	/* if x is NaN, return TRUE */
	return ((_f_log8) _btol(isnan128(x)));
}
コード例 #8
0
ファイル: inquire.c プロジェクト: manojxantony/compiler
/*
 *	_f_inqu - process INQUIRE statement.
 *
 *	Return value
 *		Returns 0 on success, positive error code if an error
 *		is encountered and ERR= or IOSTAT= are unspecified.
 *		This routine aborts on error conditions if no ERR=
 *		or IOSTAT= are specified.
 */
int _f_inqu(
FIOSPTR	css,		/* statement state			*/
unit	*cup,		/* locked unit pointer if INQUIRE by   
			 * unit and unit is connected.		*/
inlist	*a)		/* list of INQUIRE specifiers		*/
{
	int	aifound;	/* Assign info found flag	*/
	int	byfile;		/* INQUIRE by file/unit flag	*/
	int	exists;		/* File exists flag		*/
	int	opened;		/* File opened flag		*/
	int	valunit;	/* Valid unit number flag	*/
	int	errn;
	char	*buf, *fn, *s;
	struct	stat	st;	/* Stat system call packet	*/
	assign_info	ai;	/* Assign information packet	*/
	unit	*p;
	
	p	= cup;
	errn	= 0;

/*
 *	Lock _openlock to ensure that no other task opens or closes units 
 *	during the unit table scan for inquire-by-file processing.  
 */
	OPENLOCK();

	if (a->infile != NULL)		/* if INQUIRE by file */
		byfile	= 1;
	else {				/* else INQUIRE by unit */
		byfile	= 0;
		valunit	= GOOD_UNUM(a->inunit) &&
			  !RSVD_UNUM(a->inunit);	/* Valid Unit Number? */
	}
  
	if ((buf = malloc(MAX(a->infilen + 1, MXUNITSZ + 1))) == NULL) {
		errn	= FENOMEMY;
		if (a->inerr)
			goto out_of_here;
		_ferr(css, errn);
	}
  
	*buf	= '\0';		/* Assume no name */
	opened	= 0;		/* Assume not opened */
	fn	= buf;
  
	if (byfile) {		/* If INQUIRE by file */
  
		_copy_n_trim(a->infile, a->infilen, buf);
  
		if ((aifound = _get_a_options(0, buf, -1, 0, &ai, NULL,
					_LELVL_RETURN)) == -1) {

			errn	= errno;

			if (a->inerr) {
				free(buf);
				goto out_of_here;
			}
			_ferr(css, errn);
		}
  
		if (aifound && ai.a_actfil_flg)		/* If assign alias */
			s	= ai.a_actfil; /* Use -a attribute as file name */
		else
			s	= buf;
  
		exists	= (stat(s, &st) != -1);
  
		if (exists) {

			p	= _get_next_unit(NULL, 1, 1);

			while (p != NULL) {	/* while more open units */
				unum_t	unum;

				unum	= p->uid;

				if (! RSVD_UNUM(unum) &&
				    (p->uinode  == st.st_ino) &&
				    (p->udevice == st.st_dev)) {
					fn	= p->ufnm;
					opened	= 1;
					break;
				}
				p	= _get_next_unit(p, 1, 1);
			}
			/*
 			 * If p is non-null here, it points to a locked unit.
			 * The unit is locked to ensure a consistent set of
			 * INQUIRE'd attributes is returned.
			 */
		}
	}
	else {			/* Else INQUIRE by unit */
		if (valunit) {
			opened	= (cup != NULL);
			if (opened) {		/* If opened, get name */
				p	= cup;
				fn	= p->ufnm;
			}
		}
	}
  
	if (fn == NULL)		/* If no name available, return blanks */
		fn	= "";

	/* EXIST specifier */
  
	if (a->inex != NULL)
		if (byfile)	/* If INQUIRE by file */
			*a->inex	= _btol(exists);
		else		/* INQUIRE by unit    */
			*a->inex	= _btol(valunit); 
 
	/* OPENED specifier */
  
	if (a->inopen != NULL)
		*a->inopen	= _btol(opened);

	/* NAMED specifier */
  
	if (a->innamed != NULL)
		if (byfile)	/* If INQUIRE by file */
			*a->innamed	= _btol(1);		/* .TRUE. */
		else		/* INQUIRE by unit    */
			*a->innamed	= _btol(opened && p->ufnm != NULL);
  
	/* NUMBER specifier */
  
	if (a->innum != NULL) {
		if (opened) {
			if (byfile)	/* If INQUIRE by file */
				*a->innum	= (opened) ? p->uid : -1;
			else		/* INQUIRE by unit    */
				*a->innum	= a->inunit; /* The law of identity */
		}
		else
			*a->innum = -1;
	}
  
	/* RECL specifier */
  
	if (a->inrecl != NULL)
		if (opened) {
			if (p->urecl > 0)	/* If recl was specified */
				*a->inrecl	= p->urecl;
			else	/* Recl not specified (i.e., sequential) */
				*a->inrecl	= (p->ufmt) ? p->urecsize : LONG_MAX;
		}
		else 
			*a->inrecl	= -1;
  
	/* NEXTREC specifier */
  
	if (a->innrec != NULL)
		if (opened && p->useq == 0)	/* If opened & direct access */
			*a->innrec	= p->udalast + 1;
		else
			*a->innrec	= -1;
  
	/* NAME specifier */
  
	if (a->inname != NULL)
		_b_char(fn, a->inname, a->innamlen);
  
	/* ACCESS specifier */

	if (a->inacc != NULL) {
		if (opened)
			s	= (p->useq) ? "SEQUENTIAL" : "DIRECT";
		else
			s	= "UNDEFINED";
		_b_char(s, a->inacc, a->inacclen);
	}
 
	/* SEQUENTIAL specifier */

	if (a->inseq != NULL) {
		if (opened)
			s	= (p->useq) ? "YES" : "NO";
		else
			s	= "UNKNOWN";
		_b_char(s, a->inseq, a->inseqlen);
	}
  
	/* DIRECT specifier */

	if (a->indir != NULL) {
		if (opened)
			s	= (p->useq) ? "NO" : "YES";
		else
			s	= "UNKNOWN";
		_b_char(s, a->indir, a->indirlen);
	}
  
	/* FORM specifier */

	if (a->inform != NULL) {
		if (opened)
			s	= (p->ufmt) ? "FORMATTED" : "UNFORMATTED";
		else
			s	= "UNDEFINED";
		_b_char(s, a->inform, (ftnlen)a->informlen);
	}
  
	/* FORMATTED specifier */

	if (a->infmt != NULL) {
		if (opened)
			s	= (p->ufmt) ? "YES" : "NO";
		else
			s	= "UNKNOWN";
		_b_char(s, a->infmt, a->infmtlen);
	}
  
	/* UNFORMATTED specifier */

	if (a->inunf != NULL) {
		if (opened)
			s	= (p->ufmt) ? "NO" : "YES";
		else
			s	= "UNKNOWN";
		_b_char(s, a->inunf, a->inunflen);
	}
  
	/* BLANK specifier */

	if (a->inblank != NULL) {
		if (opened && p->ufmt)
			s	= (p->ublnk) ? "ZERO" : "NULL";
		else
			s	= "UNDEFINED";
		_b_char(s, a->inblank, a->inblanklen);
	}
  
	/* POSITION specifier */

	if (a->inposit != NULL) {	/* Fortran 90 position control */
		if (opened && p->useq) {
			switch (p->uposition) {
				case OS_REWIND:
					s	= "REWIND";
					break;
				case OS_ASIS:
					s	= "ASIS";
					break;
				case OS_APPEND:
					s	= "APPEND";
					break;
				case 0:
					s	= "UNKNOWN";
					break;
				default:
					_ferr(css, FEINTUNK);
			}
		}
		else
			s	= "UNDEFINED";
		_b_char(s, a->inposit, a->inpositlen);
	}

	/* ACTION specifier */

	if (a->inaction != NULL) { 	/* Fortran 90 action control */
		if (opened) {
			switch (p->uaction) {
				case OS_READWRITE:
					s	= "READWRITE";
					break;
				case OS_READ:
					s	= "READ";
					break;
				case OS_WRITE:
					s	= "WRITE";
					break;
				default:
					_ferr(css, FEINTUNK);
			}
		}
		else	/* for an unconnected file */
			s	= "UNDEFINED";
		_b_char(s, a->inaction, a->inactonlen);
	}

	/* READ specifier */

	if (a->inread != NULL) {	/* Fortran 90 read action control */
		if (opened) {
			if ((p->uaction == OS_READ) ||
			    (p->uaction == OS_READWRITE))
				s	= "YES";
			else
				s	= "NO";
		}
		else
			s	= "UNKNOWN";
		_b_char(s, a->inread, a->inreadlen);
	}

	/* WRITE specifier */

	if (a->inwrite != NULL) {	/* Fortran 90 write action control */
		if (opened) {
			if ((p->uaction == OS_WRITE) ||
			    (p->uaction == OS_READWRITE))
				s	= "YES";
			else
				s	= "NO";
		}
		else
			s	= "UNKNOWN";
		_b_char(s, a->inwrite, a->inwritelen);
	}

	/* READWRITE specifier */

	if (a->inredwrit != NULL) {  /* Fortran 90 read/write action control */
		if (opened) {
			if (p->uaction == OS_READWRITE)
				s	= "YES";
			else
				s	= "NO";
		}
		else
			s	= "UNKNOWN";
		_b_char(s, a->inredwrit, a->inrdwrtlen);
	}

	/* DELIM specifier */

	if (a->indelim != NULL) { /* Fortran 90 delim control */
		if (opened && p->ufmt) {	/* if formatted */
			switch (p->udelim) {
				case OS_NONE:
					s	= "NONE";
					break;
				case OS_QUOTE:
					s	= "QUOTE";
					break;
				case OS_APOSTROPHE:
					s	= "APOSTROPHE";
					break;
				default:
					_ferr(css, FEINTUNK);
			}
		}
		else   /* UNDEFINED for unformatted or unconnected file */
			s	= "UNDEFINED";
		_b_char(s, a->indelim, a->indelimlen);
	}

	/* PAD specifier */

	if (a->inpad != NULL) {  /* Fortran 90 pad control */
		if(opened && p->ufmt) { 	/* if formatted */
			switch (p->upad) {
				case OS_YES:
					s	= "YES";
					break;
				case OS_NO:
					s	= "NO";
					break;
				default:
					_ferr(css, FEINTUNK);
			}
		}
		else /* Fortran 90 missed UNDEFINED if unformatted or unconnected */
			s	= "YES";   /* set to YES instead of UNDEFINED */
		_b_char(s, a->inpad, a->inpadlen);
	}

/*
 *	Unlock the unit if we have a pointer to an open unit.   Note that
 *	$INQ/_INQUIRE never unlocks the unit.
 */
out_of_here:

	OPENUNLOCK();

	if (p != NULL)
		_release_cup(p);	/* unlock the unit */

	free(buf);
	return(errn);
}
コード例 #9
0
ファイル: all.c プロジェクト: xyuan/Path64
void
__all  (	DopeVectorType * result,
	DopeVectorType * mask,
	_f_int	*dimension)
{
	int	c_dim;		/* C form of input dimension	*/
	int	other_dim;	/* other dimension in rank-2	*/
	int	num_elts =	 1;	/* elts in result array	*/
	long	nbytes =	 0;	/* bytes to malloc 	*/
	_f_log * irptr;		/* ptr to result array	*/
	_f_log * imptr;		/* ptr to mask array	*/
	_f_log4 * i4rptr;	/* ptr to result array	*/
	_f_log4 * i4mptr;	/* ptr to mask array	*/
	_f_log8 * i8rptr;	/* ptr to result array	*/
	_f_log8 * i8mptr;	/* ptr to mask array	*/
#ifdef	_F_LOG1
	_f_log1 * i1rptr;	/* ptr to result array	*/
	_f_log1 * i1mptr;	/* ptr to mask array	*/
#endif
#ifdef	_F_LOG2
	_f_log2 * i2rptr;	/* ptr to result array	*/
	_f_log2 * i2mptr;	/* ptr to mask array	*/
#endif
	long	i, j;		/* index variables		*/
	long	indx, jndx;	/* loop indices			*/
	int	done, stop;	/* work done indicators		*/
	int	el_len;		/* LTOB length indicator	*/
	int	mshftct=0;	/* mask amount to shift index 	*/
	int	rshftct=0;	/* result amount to shift index	*/

	/*	Per-dimension arrays	*/
	long	current_place[MAXDIM-1];	/* current place*/
	long	mask_offset[MAXDIM-1];		/* mask offset	*/
	long	mask_extent[MAXDIM-1];		/* mask extent	*/
	long	mask_stride[MAXDIM-1];		/* mask stride	*/
	long	result_offset[MAXDIM-1];	/* result offset*/
	long	result_stride[MAXDIM-1];	/* result stride*/
	long	cdim_mask_stride;		/* cdim stride	*/

	/* Validate dimension variable	*/
	if (dimension != NULL && mask->n_dim > 1) {
		c_dim =	*dimension - 1;
		if (c_dim < 0 || c_dim >= mask->n_dim)
        		_lerror (_LELVL_ABORT, FESCIDIM);
	} else {
		c_dim = 0;
		if (dimension != NULL) {
			if (*dimension  < 1 || *dimension > mask->n_dim)
				_lerror (_LELVL_ABORT, FESCIDIM);
		}
	}

	/* Setup dope vector for result array	*/
	if (!result->assoc) {
		int sm	= 1;
		if (result->base_addr.a.el_len >= BITS_PER_WORD)
			sm =	result->base_addr.a.el_len / BITS_PER_WORD;
		if (dimension != NULL) {
			for (i = 0; i < c_dim; i++) {
				result->dimension[i].extent =
					mask->dimension[i].extent;
				result->dimension[i].low_bound =	1;
				result->dimension[i].stride_mult =
					num_elts * sm;
				num_elts *=	mask->dimension[i].extent;
			}
			for ( ; i < result->n_dim; i++) {
				result->dimension[i].extent =
					mask->dimension[i+1].extent;
				result->dimension[i].low_bound =	1;
				result->dimension[i].stride_mult =
					num_elts * sm;
				num_elts *=	mask->dimension[i+1].extent;
			}
		}

		result->base_addr.a.ptr =	(void *) NULL;

		nbytes = ((num_elts * result->base_addr.a.el_len) /
				BITS_PER_BYTE);
		if (nbytes != 0) {
			result->base_addr.a.ptr = (void *) malloc (nbytes);
			if (result->base_addr.a.ptr == NULL)
       				_lerror(_LELVL_ABORT, FENOMEMY);
			result->assoc = 1;
		}

		/* set fields for null array as well */
		result->orig_base = result->base_addr.a.ptr;
		result->orig_size = nbytes * BITS_PER_BYTE;
	}

	/* Set pointer to result array and initialize result array to TRUE */
	irptr =		(void *) result->base_addr.a.ptr;
	switch (result->type_lens.int_len) {
		case 64 :
			i8rptr = (_f_log8 *) result->base_addr.a.ptr;
#ifdef _F_LOG4
			if (sizeof(_f_int) == sizeof(_f_log4))
				rshftct = 	1;
#endif
#ifdef _UNICOS
#pragma _CRI     ivdep
#endif
			for (i = 0; i < num_elts; i++) {
				i8rptr[i] = (_f_log8) _btol(1);
			}
			break;
#ifdef _F_LOG2
		case 16 :
			i2rptr = (_f_log2 *) result->base_addr.a.ptr;
			for (i = 0; i < num_elts; i++) {
				i2rptr[i] = (_f_log2) _btol(1);
			}
			break;
#endif
#ifdef _F_LOG1
		case 8 :
			i1rptr = (_f_log1 *) result->base_addr.a.ptr;
			for (i = 0; i < num_elts; i++) {
				i1rptr[i] = (_f_log1) _btol(1);
			}
			break;
#endif
		case 32 :
		default :
			i4rptr = (_f_log4 *) result->base_addr.a.ptr;
#ifdef _UNICOS
#pragma _CRI     ivdep
#endif
			for (i = 0; i < num_elts; i++) {
				i4rptr[i] = (_f_log4) _btol(1);
			}
	}

	imptr =		(void *) mask->base_addr.a.ptr;
	switch (mask->type_lens.int_len) {
		case 64 :
			el_len =	sizeof(_f_log8) * BITS_PER_BYTE;
			i8mptr =	(_f_log8 *) imptr;
#ifdef _F_LOG4
		/* Set mask shftct for ALL with no size specified since
		 * no size means a 64-bit logical value.  A default of
		 * 32-bit logical has a stride_mult of two for a 64-bit
		 * logical on WORD32.  Normally, the ALL_8 entry point
		 * is used.  On MPP, the stride_mult is one for 32-bit
		 * or 64-bit logical.
		 */
			if (sizeof(_f_int) == sizeof(_f_log4))
				mshftct = 	1;
#endif
			break;
#ifdef _F_LOG2
		case 16 :
			el_len =	sizeof(_f_log2) * BITS_PER_BYTE;
			i2mptr =	(_f_log2 *) imptr;
			break;
#endif
#ifdef _F_LOG1
		case 8 :
			el_len =	sizeof(_f_log1) * BITS_PER_BYTE;
			i1mptr =	(_f_log1 *) imptr;
			break;
#endif
		case 32 :
		default :
			el_len =	sizeof(_f_log4) * BITS_PER_BYTE;
			i4mptr =	(_f_log4 *) imptr;
	}

	/* check for zero-sized mask array */
	for (i = 0; i < mask->n_dim; i++) {
		if (mask->dimension[i].extent == 0)
			return;
	}

	/* Handle a rank-one mask array	*/
	if (mask->n_dim == 1) {

		/* Use local mask_stride and divide by two when two-word
		 * logical is being done.
		 */
#ifdef _F_LOG4
		mask_stride[0] = (mask->dimension[0].stride_mult) >> mshftct;
#else
		mask_stride[0] = mask->dimension[0].stride_mult;
#endif
	/* Scan array until a FALSE element is found */
		i = 0;
		indx = 0;
		switch (mask->type_lens.int_len) {
		    case 64 :
			while (i < mask->dimension[0].extent) {
				if (LTOB(el_len, (i8mptr + indx))) {
					/* true element */
					i++;
					indx = i * mask_stride[0];
				} else {
					/* false element */
					switch (result->type_lens.int_len) {
					    case 64 :
						i8rptr[0] = (_f_log8) _btol(0);
						break;
#ifdef _F_LOG2
					    case 16 :
						i2rptr[0] = (_f_log2) _btol(0);
						break;
#endif
#ifdef _F_LOG1
					    case 8 :
						i1rptr[0] = (_f_log1) _btol(0);
						break;
#endif
					    case 32 :
					    default :
						i4rptr[0] = (_f_log4) _btol(0);
					}
					i = mask->dimension[0].extent;
				}
			}
			break;
#ifdef _F_LOG2
		    case 16 :
			while (i < mask->dimension[0].extent) {
				if (LTOB(el_len, (i2mptr + indx))) {
					/* true element */
					i++;
					indx = i * mask_stride[0];
				} else {
					/* false element */
					switch (result->type_lens.int_len) {
					    case 64 :
						i8rptr[0] = (_f_log8) _btol(0);
						break;
					    case 16 :
						i2rptr[0] = (_f_log2) _btol(0);
						break;
#ifdef _F_LOG1
					    case 8 :
						i1rptr[0] = (_f_log1) _btol(0);
						break;
#endif
					    case 32 :
					    default :
						i4rptr[0] = (_f_log4) _btol(0);
					}
					i = mask->dimension[0].extent;
				}
			}
			break;
#endif
#ifdef _F_LOG1
		    case 8 :
			while (i < mask->dimension[0].extent) {
				if (LTOB(el_len, (i1mptr + indx))) {
					/* true element */
					i++;
					indx = i * mask_stride[0];
				} else {
					/* false element */
					switch (result->type_lens.int_len) {
					    case 64 :
						i8rptr[0] = (_f_log8) _btol(0);
						break;
					    case 16 :
						i2rptr[0] = (_f_log2) _btol(0);
						break;
					    case 8 :
						i1rptr[0] = (_f_log1) _btol(0);
						break;
					    case 32 :
					    default :
						i4rptr[0] = (_f_log4) _btol(0);
					}
					i = mask->dimension[0].extent;
				}
			}
			break;
#endif
		    case 32 :
		    default :
			while (i < mask->dimension[0].extent) {
				if (LTOB(el_len, (i4mptr + indx))) {
					/* true element */
					i++;
					indx = i * mask_stride[0];
				} else {
					/* false element */
					switch (result->type_lens.int_len) {
					    case 64 :
						i8rptr[0] = (_f_log8) _btol(0);
						break;
#ifdef _F_LOG2
					    case 16 :
						i2rptr[0] = (_f_log2) _btol(0);
						break;
#endif
#ifdef _F_LOG1
					    case 8 :
						i1rptr[0] = (_f_log1) _btol(0);
						break;
#endif
					    case 32 :
					    default :
						i4rptr[0] = (_f_log4) _btol(0);
					}
					i = mask->dimension[0].extent;
				}
			}
		}

	/* Handle a rank-two mask array	*/
	} else if (mask->n_dim == 2) {
コード例 #10
0
ファイル: ieee_is_nan_r.c プロジェクト: sharugupta/OpenUH
_f_log8 _IEEE_IS_NAN_L8( _f_real8 x)
{
	/* if x is NaN, return TRUE */
	return ((_f_log8) _btol(isnan64(x)));
}