/**************************************************************************/
/*                                                                        */
/*                                 Sources                                */
/*                                from  the                               */
/*                           XSC SOFTWARE PACKAGE                         */
/*                                                                        */
/*                Copyright (c) 1997 University of Karlsruhe              */
/*                     Institute for Appl. Mathematics                    */
/*                                                                        */
/* This program is free software for non-commercial use. For details, see */
/* the file LICENSE.XSC, distributed with this software package.          */
/*                                                                        */
/* This program is distributed WITHOUT ANY WARRANTY. For details, see the */
/* file LICENSE.XSC, distributed with this software package.              */
/*                                                                        */
/**************************************************************************/

/* RCS $Id: t_sinv.c,v 1.3 1997/09/25 18:22:37 ae59 Exp $ */
/*
$Log: t_sinv.c,v $
 * Revision 1.3  1997/09/25  18:22:37  ae59
 * Copyright-message
 *
 * Revision 1.2  1994/10/25  11:46:39  ae59
 * add Shortabtyp, changed long to a_Btyp, changed long cnsts
 *
 * Revision 1.1  1994/01/27  13:25:48  ae59
 * Put under RCS control
 *
 */
/*****************************************************************
**                                                              **
**  exam.c   16.01.91 Baumhof                                   **
**                                                              **
**  Zahlklassifizierung (fxam im 80387)                         **
**                                                              **
**  Format:                                                     **
**      int _s_xam(const ExtReal *arg);                         **
**      int _s_chk_invalid(const ExtReal *arg);                 **
**                                                              **
**      Date    : 1992-07-21                                    **
**      1992-07-21 : add sun4_gnu_c sun4_cpp_c =b=              **
**      1992-06-23 : switched back to 80bit SW (SPARC)          **
**      1992-05-12 : support for SPARC FP HW (IEEE 128bit)      **
**      1991-09-06 : reduce maximum line length                 **
*****************************************************************/

#ifdef AIX
#include "/u/p88c/runtime/tbyte/t_defs.h"
#else
#include "t_defs.h"
#endif

#if SHORTABTYP
#define UMSB (a_btyp)0x80000000
#else
#define UMSB 0x80000000L
#endif

#ifdef IEEE_HARDWARE
#if SUN4_OS4_C+SUN4_GNU_C+SUN4_CPP_C
/* #define __CB_SUN4_OS4_HARDWARE */
#endif
#endif


#ifndef __CB_SUN4_OS4_HARDWARE


#ifdef ANSI_C
#ifdef LINT_ARGS
int _s_xam(const ExtReal *arg)
#else
int _s_xam(arg)
const ExtReal *arg;
#endif /* LINT_ARGS */
#else  /* NOT ANSI_C */
#ifdef LINT_ARGS
int _s_xam(ExtReal *arg)
#else
int _s_xam(arg)
ExtReal *arg;
#endif /* LINT_ARGS */
#endif /* ANSI_C */
{
    unsigned char vz;           /* Vorzeichen von arg */
    unsigned short int exp;     /* Exponent von arg */
    a_btyp mant[2];  /* Mantisse von arg, 64=32+32 bit */

    /* Dekomposition */
    vz = (arg->s.exp&ExtSignMask) ? 1 : 0;
    exp = arg->s.exp&ExtExpMask;
    mant[0] = ((((((a_btyp)arg->s.DIGIT(3)<<8)
                + (a_btyp)arg->s.DIGIT(2))<<8)
                + (a_btyp)arg->s.DIGIT(1))<<8)
                + (a_btyp)arg->s.DIGIT(0);
    mant[1] = ((((((a_btyp)arg->s.DIGIT(7)<<8)
                + (a_btyp)arg->s.DIGIT(6))<<8)
                + (a_btyp)arg->s.DIGIT(5))<<8)
                + (a_btyp)arg->s.DIGIT(4);

    /* Unendlich */
    if (exp==32767 && !mant[0] &&
        mant[1]==(a_btyp)UMSB)
       return(vz ? MInf : PInf);

    /* NAN */
    else if (exp==32767)
        return(vz ? MNAN : PNAN);

    /* Null */
    else if (!(mant[0]|mant[1]))
        return(vz ? MZero : PZero);

    /* denormal oder pseudodenormal */
    else if (exp==0)
        return(vz ? MDenorm : PDenorm);

    /* 8087 unnormal (unsupported) */
    else if (!(mant[1] & UMSB))
        return(vz ? MUnorm : PUnorm);

    /* normal */
    else
        return(vz ? MNorm : PNorm);
}



#ifdef ANSI_C
#ifdef LINT_ARGS
int _s_chk_invalid(const ExtReal *arg)
#else
int _s_chk_invalid(arg)
const ExtReal *arg;
#endif /* LINT_ARGS */
#else  /* NOT ANSI_C */
#ifdef LINT_ARGS
int _s_chk_invalid(ExtReal *arg)
#else
int _s_chk_invalid(arg)
ExtReal *arg;
#endif /* LINT_ARGS */
#endif /* ANSI_C */
{
    return(_s_xam(arg)&(PUnorm|MUnorm|PNAN|MNAN|PInf|MInf));
}


#else	/* __CB_SUN4_OS4_HARDWARE */


#ifdef ANSI_C
#ifdef LINT_ARGS
int _s_xam(const ExtReal *arg)
#else
int _s_xam(arg)
const ExtReal *arg;
#endif /* LINT_ARGS */
#else  /* NOT ANSI_C */
#ifdef LINT_ARGS
int _s_xam(ExtReal *arg)
#else
int _s_xam(arg)
ExtReal *arg;
#endif /* LINT_ARGS */
#endif /* ANSI_C */
{
    unsigned char vz;           /* Vorzeichen von arg */
    unsigned short int exp;     /* Exponent von arg */
    a_btyp mant[4];  /* Mantisse von arg, 17+32+32+32 bit */

    /* Dekomposition */
    vz = (arg->s.exp&ExtSignMask) ? 1 : 0;
    exp = arg->s.exp&ExtExpMask;
    mant[0] = ((*(a_btyp *)arg)&0x0ffff) /*+0x010000*/ ;	/* 17 bit */
    mant[1] = *(((a_btyp *)arg)+1);			/* 3*32 bit */
    mant[2] = *(((a_btyp *)arg)+2);
    mant[3] = *(((a_btyp *)arg)+3);

    /* Unendlich */
    if (exp==32767 && !(mant[0]|mant[1]|mant[2]|mant[3]))
       return(vz ? MInf : PInf);

    /* NAN */
    else if (exp==32767)
        return(vz ? MNAN : PNAN);

    /* Null */
    else if (!exp && !(mant[0]|mant[1]|mant[2]|mant[3]))
        return(vz ? MZero : PZero);

    /* denormal oder pseudodenormal */
    else if (exp==0)
        return(vz ? MDenorm : PDenorm);

    /* normal */
    else
        return(vz ? MNorm : PNorm);
}



#ifdef ANSI_C
#ifdef LINT_ARGS
int _s_chk_invalid(const ExtReal *arg)
#else
int _s_chk_invalid(arg)
const ExtReal *arg;
#endif /* LINT_ARGS */
#else  /* NOT ANSI_C */
#ifdef LINT_ARGS
int _s_chk_invalid(ExtReal *arg)
#else
int _s_chk_invalid(arg)
ExtReal *arg;
#endif /* LINT_ARGS */
#endif /* ANSI_C */
{
    return(_s_xam(arg)&(PUnorm|MUnorm|PNAN|MNAN|PInf|MInf));
}


#endif	/* __CB_SUN4_OS4_HARDWARE */
#undef UMSB
