/* @(#)Copyright (c), 1987, 1996 StatSci, Inc.  All rights reserved. */
/* @(#)S_specials.h version 3.2 created 6/4/96 */
/***
   NAME S_specials
   PURPOSE
     Split off some IEEE special value handling macros from S.h to make
     for easier inclusion into other sources.
   NOTES
***/
#ifndef S_specialsINCLUDED
#define S_specialsINCLUDED 1

/* Pre-requisite includes go here. */
#include <cdefs.h>
#include <ansi_things.h>
SCCS_ID_C(S_specialsDotH,@(#)S_specials.h 3.2 last edit 6/4/96 StatSci)

#include <system.h>

#ifdef S_specialsDEFINE
#define INIT(x) = x
#define vextern
#else
#define INIT(x)
#define vextern extern
#endif /* S_specialsDEFINE */

#define LPNTR(a) ((long *) (a))
#define RPNTR(a) ((float *) (a))
#define DPNTR(a) ((double *) (a))

/* Keep the following in sync. They all have to do with testing/setting NA's
 * and Inf's:
 * 
 * $QPE/comp_util.c:test_na,set_na,test_inf,set_inf
 * $INC/S.h:is_na,is_na_*,is_inf,is_inf_*
 * $I/u/mach.m[pp]:NA,INF
 * $P/natst.C, $P/inftst.C
 * $DEV/gr_extern/test_inf.c
 * $SL/data.ed/S_specials.c
 */

/* macros for testing and setting special values */
#include "newNA.h"
#define is_na(a,m) test_na((VOID_P)(a),m)
#define is_nan(a,m) (((m)==COMPLEX)?is_na((a),(m)):(is_na((a),(m))!=0))
#define na_set3(a,m,t)   set_na((VOID_P)(a),m,(t))
#define na_set(a,m) set_na((VOID_P)(a),m,To_NA)
#define is_inf(a,m) test_inf((VOID_P)(a),m)
#define inf_set(a,m,s) set_inf((VOID_P)(a),m,s)
/*
 * Fast macros for testing NA's/NaN's/Inf's when mode known at compile time.
 * These must be kept in sync with comp_util.c:test_na() and test_inf(). The 
 * fast macros are used if DO_NOT_INLINE_IS_NA is not defined.
 * IEEE754 is defined by system.h.
 */

#ifdef DO_NOT_INLINE_IS_NA	/*(*/

#define is_na_pattern(a)	is_na((a),INT)
    /* works independent of mode for all Splus-created data since 2.3 */

/* is_nan_{LGL,INT}: test whether it's NA_PATTERN. Strictly speaking there are 
   no non-float NaN's. */
#define is_nan_LGL(a)		is_nan((a),LGL)
#define is_nan_INT(a)		is_nan((a),INT)
#define is_nan_CHAR(a)		0
#define is_nan_REAL(a)		is_nan((a),REAL)
#define is_nan_DOUBLE(a)	is_nan((a),DOUBLE)
#define is_nan_COMPLEX(a)	is_nan((a),COMPLEX)

#define is_na_LGL(a)		is_na((a),LGL)
#define is_na_INT(a)		is_na((a),INT)
#define is_na_CHAR(a)		0
#define is_na_REAL(a)		is_na((a),REAL)
#define is_na_DOUBLE(a)		is_na((a),DOUBLE)
#define is_na_COMPLEX(a)	is_na((a),COMPLEX)

#define is_inf_LGL(a)		0
#define is_inf_INT(a)		0
#define is_inf_CHAR(a)		0
#define is_inf_REAL(a)		is_inf((a),REAL)
#define is_inf_DOUBLE(a)	is_inf((a),DOUBLE)
#define is_inf_COMPLEX(a)	is_inf((a),COMPLEX)

#else /* )( ! DO_NOT_INLINE_IS_NA */

#define is_na_pattern(a)	(*LPNTR(a) == NA_PATTERN)
    /* works independent of mode for all Splus-created data since 2.3 */

/* is_nan_{LGL,INT}: test whether it's NA_PATTERN. Strictly speaking there are 
   no non-float NaN's. */
#define is_nan_LGL(a)		is_na_pattern(a)
#define is_nan_INT(a)		is_na_pattern(a)
#define is_nan_CHAR(a)		0
#if defined(DOS386) || defined(mips)
	/* ( Any platform where x != x doesn't work */
#define is_nan_REAL(a)		(((*LPNTR(a)&FEXP_BITS)==FEXP_BITS) && (*LPNTR(a)<<9))
#define is_nan_DOUBLE(a)	(((LPNTR(a)[HI]&DEXP_BITS)==DEXP_BITS) && \
					((LPNTR(a)[HI]<<12) || LPNTR(a)[LO] ))

#else /*)( ! DOS386*/
#define is_nan_REAL(a)		(*(a) != *(a))
#define is_nan_DOUBLE(a)	(*(a) != *(a))
#endif /*) ! DOS386*/
#define is_nan_COMPLEX(a)	((is_nan_DOUBLE(DPNTR(a)) ? Is_NaN : 0) | \
	(is_nan_DOUBLE(DPNTR(a)+1) ? Is_NaNi : 0))

#define is_na_LGL(a)		is_na_pattern(a)
#define is_na_INT(a)		is_na_pattern(a)
#define is_na_CHAR(a)		0
#define is_na_REAL(a)		(is_nan_REAL(a) ? (is_na_pattern(a) ? Is_NA : Is_NaN) : 0)
#define is_na_DOUBLE(a)		(is_nan_DOUBLE(a) ? (is_na_pattern(a) ? Is_NA : Is_NaN) : 0)
#define is_na_COMPLEX(a)	(is_na_pattern(DPNTR(a)) ? \
				     Is_NA :\
				     (is_na_pattern(DPNTR(a)+1)? \
						Is_NA:\
						is_nan_COMPLEX(a)))

#define is_inf_LGL(a)		0
#define is_inf_INT(a)		0
#define is_inf_CHAR(a)		0
#if defined(DOS386) /* ( cannot do == in case *a is a NaN */
#define is_inf_REAL(a)		(is_nan_REAL(a) ? 0 : \
				 (*(a)==sPosInf ? 1 : (*(a)==sNegInf ? -1 : 0)))
#define is_inf_DOUBLE(a)	(is_nan_DOUBLE(a) ? 0 : \
				 (*(a)==dPosInf ? 1 : (*(a)==dNegInf ? -1 : 0)))
#define is_inf_COMPLEX(a)	((is_inf_DOUBLE(DPNTR(a))==1?\
					Is_Inf: \
					(is_inf_DOUBLE(DPNTR(a))?Is_NInf:0))\
				| \
				(is_inf_DOUBLE(DPNTR(a)+1)==1?\
					Is_Infi: \
					(is_inf_DOUBLE(DPNTR(a)+1)?Is_NInfi:0)))
#else /*)( ! DOS386*/
#define is_inf_REAL(a)		(*(a)==sPosInf ? 1 : (*(a)==sNegInf ? -1 : 0))
#define is_inf_DOUBLE(a)	(*(a)==dPosInf ? 1 : (*(a)==dNegInf ? -1 : 0))
#define is_inf_COMPLEX(a)	((*DPNTR(a)==dPosInf? \
					Is_Inf:\
					(*DPNTR(a)==dNegInf?Is_NInf:0)) \
				| \
				(*(DPNTR(a)+1)==dPosInf? \
					Is_Infi:\
					(*(DPNTR(a)+1)==dNegInf?Is_NInfi:0)))
#endif /*) ! DOS386*/

#endif /* ) ! DO_NOT_INLINE_IS_NA */

#ifdef S_ANSI_Syntax
#define Is_bad(t,a,m)		((t & Is_Inf) ? is_inf_##m(a) : is_na_##m(a))
#else
#define Is_bad(t,a,m)		((t & Is_Inf) ? is_inf_/**/m(a) : is_na_/**/m(a))
#endif

extern int test_na PARAMS((VOID_P p, int mode));
extern int test_inf PARAMS((VOID_P p, int mode));
extern void set_na PARAMS((VOID_P p, int mode, int type));
extern void set_inf PARAMS((VOID_P p, int mode, int type));

#ifdef IEEE754
vextern int na_t;
vextern float sPosInf, sNegInf, sNaN;
vextern double dPosInf, dNegInf, dNaN;
#endif

#undef INIT
#undef vextern

/* Sub-includes go here. */
#endif /* S_specialsINCLUDED */