/**************************************************************************/
/*                                                                        */
/*                                 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_xtre.c,v 1.3 1997/09/25 18:24:41 ae59 Exp $ */
/*
$Log: t_xtre.c,v $
 * Revision 1.3  1997/09/25  18:24:41  ae59
 * Copyright-message
 *
 * Revision 1.2  1994/10/25  11:49:04  ae59
 * add Shortabtyp, changed long to a_Btyp, changed long cnsts
 *
 * Revision 1.1  1994/01/27  13:25:53  ae59
 * Put under RCS control
 *
 */
/*****************************************************************
**                                                              **
**  extract.c   17.01.91 Baumhof                                **
**                                                              **
**  liefert Mantisse und Exponent als ExtReal                   **
**                                                              **
**  Format:                                                     **
**      int xtracte(const ExtReal *arg, ExtReal *rmant,         **
**                                      ExtReal *rexp);         **
**                                                              **
**      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)      **
*****************************************************************/

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

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

/* #include <stdlib.h> */
/* already included by o_defs.h
#ifdef LINT_ARGS
extern int abs(int);
#else
extern int abs();
#endif
*/

#ifdef ANSI_C
#ifdef LINT_ARGS
int xtracte(const ExtReal *arg, ExtReal *rmant, ExtReal *rexp)
#else
int xtracte(arg, rmant, rexp)
const ExtReal *arg;
      ExtReal *rmant;
      ExtReal *rexp;
#endif /* LINT_ARGS */
#else  /* NOT ANSI_C */
#ifdef LINT_ARGS
int xtracte(ExtReal *arg, ExtReal *rmant, ExtReal *rexp)
#else
int xtracte(arg, rmant, rexp)
ExtReal *arg;
ExtReal *rmant;
ExtReal *rexp;
#endif /* LINT_ARGS */
#endif /* ANSI_C */
{
    unsigned char vz;           /* Vorzeichen von arg bzw. exp */
    short int exp;              /* wahrer Exponent von arg */
    unsigned short int e;       /* Betrag von exp, um 15-s bit nach links */
    int s;                      /* Exponent von exp */

    /* Null ?  ==>  Fehler */
    if (0==cmpee(&Zero, arg))
    {
        copyee(&MInfty, rexp);
        copyee(&Zero, rmant);
        return(ExcDBZ);
    }

    /* Dekomposition */
    vz = (arg->s.exp&ExtSignMask) ? 1 : 0;
    exp = (arg->s.exp&ExtExpMask) - ExtExpBias;

    /* Mantisse */
    copyee(arg, rmant);
    rmant->s.exp = ExtExpBias + (vz ? ExtSignMask : 0);

    /* Exponent, konvertieren nach ExtReal */
    copyee(&Zero, rexp);
    if (exp)
    {
        vz = (exp<0 ? 1 : 0);
        e = abs(exp);
        s = 15;
        while (!(e&0x8000)) { s--; e <<= 1; }
#ifndef __CB_SUN4_OS4_HARDWARE
        rexp->s.exp = ((ExtExp)s + ExtExpBias) + (vz ? ExtSignMask : 0);
        rexp->s.DIGIT(6) = e & 0x0ff;
        rexp->s.DIGIT(7) = (e & 0x0ff00)>>8;
#else
	*(a_btyp *)rexp =
		(((a_btyp)
		  (((ExtExp)s + ExtExpBias) + (vz ? ExtSignMask : 0)))<<16)
		+ (a_btyp)((e<<1)&0x0ffff);
#endif

    }
    return(0);
}
