
#define FP_bscalbi	0	/* ENUM_DEBUG */

/* $Header:xFPE_bscalb.c 12.0$ */
/* $ACIS:xFPE_bscalb.c 12.0$ */
/* $Source: /ibm/acis/usr/src/usr.lib/libfp/emulfp/RCS/xFPE_bscalb.c,v $ */

#if !defined(lint) && !defined(aiws)
static char *rcsid = "$Header:xFPE_bscalb.c 12.0$";
#endif
 
/* @(#)E_bscalb.c	7.1 - 87/06/16 - 04:49:25 */
/**********************************************************************/
/*
 *      E_bscalb.c
 *
 *      Emulation version of IEEE scalb for behind the vector
 *
 *      This file was made from E_FPSCALB.c. It differs from E_FPSCALB.c
 *      in the fact that it is a stand alone routine whereas E_FPSCALB.c
 *      is a subfunction called by other emulation routines.
 *
 */
/**********************************************************************/
/*

	bscalb returns value*2**exp.
 
        Copyright 1985 by K.C. Ng.
        Permission to use this program is granted, provided that:
            1.  Users agree to report any problems with this
                program to:
                        K.C. Ng
                        2633 San Jose Ave.
                        San Francisco, CA 94112
            2.  This note appears in each copy of the source program.
 
        This code was revised by ACIS Development to match
        F.P.E. conventions.

	This version is used with the emulation code.


 */
 
#ifdef ibm032
#include <machine/fp.h>
#else !ibm032
#include <sys/FP.h>
#include <sys/ltypes.h> 
#endif ibm032 

static short PREP1=54;			/* a result with an exponent no less*/
					/* than MINEXP-PREP1 can be made a  */
					/* subnormal number		    */
static short MAXSCALEXP=2100;		/* = (BIAS*2 + PREP1) -- If the arg */
					/* exp has a magnitude greater than */
					/* this constant, over/under flow   */
					/* will assuredly occur. A simple   */
					/* test determines this before it   */
					/* happens.			    */


FP_DOUBLE
_Ebscalbi(reg,ival)
int reg,ival;
{
	int r1 = reg & OKREGBITS;
	long v1exp;
	unsigned long sign, val1a, val1b;
	FP_DOUBLE FPdovfl(), FPdunfl();
	double d1;
	unsigned int *pd1 = (unsigned int *)&d1;
#ifdef ibm032				/* see note in fp.h	*/
FP_MACH machine = findfpm();
#endif ibm032

	/* copy scale value into fp6 in case an exception occurs. */
	machine.dreg[6].dfracth = ival;
	machine.dreg[6].dfractl = 0;
	SetOperation(FP_bscalbi,r1,6); /* set source as 6 */
	*pd1 =     machine.dreg[r1].dfracth;  /* move reg into d1 */
	*(pd1+1) = machine.dreg[r1].dfractl;
	if ( dTRAP_NaN(machine.dreg[r1]) ){
		if ( !set_stat(EM_INV_OPER) ){
			StoQDNaN(d1);
			machine.dreg[r1].dfracth = *pd1;
			machine.dreg[r1].dfractl = *(pd1+1);
		}
		dFP_ret(reg);
	}

	/* QNaN, Infinity or Zero returns d1 and doesn't change reg */
	if ( (!FINITE(d1)) || (IS_ZERO(d1)) ) return(d1);

	v1exp = ((VALH(d1) & DEXPBITS) >> 20) - DEXPBIAS;    /* exponent */
	sign =  VALH(d1) & BIT31;            /* save the sign            */
	val1a = VALH(d1) & LO20BITS;         /* high 20 bits of fraction */
	val1b = VALL(d1);                    /* low 32 bits of fraction  */
 
	if (ival < -MAXSCALEXP)               /* scale exponent will   */
	{                                     /* cause underflow       */
		ival = -MAXSCALEXP;
	}
	if (ival > MAXSCALEXP)                /* scale exponent will   */
	{                                     /* cause overflow        */
		ival = MAXSCALEXP;
	}
	if (v1exp == DEXPLO)                    /* subnormal value?    */
	{       val1a = (val1a << 1) | (val1b >> 31); /* correct for subn. */
		val1b <<= 1;
		while (!(val1a & BIT20))	/* we can normalize because */
		{				/* we have a long for exp.  */
		     val1a = (val1a << 1) | (val1b >> 31);
		     val1b <<= 1;
		     v1exp--;
		}
	}
	else
		val1a |= BIT20;
 
	v1exp += ival;                           /* new exponent      */
	if (v1exp >= DEXPHI)                    /* overflow?          */
	{                                       /* signal it          */
		v1exp = (v1exp + (DEXPBIAS-DOVBIAS)) & LO11BITS;
		SetData(sign|(v1exp << 20)|(val1a & LO20BITS), val1b);
		if (set_stat(EM_OVERFLOW)) {
			dFP_ret(reg);
			}
		return(FPdovfl(sign,r1,reg));
	}
	if (v1exp <= DEXPLO)                    /* underflow?         */
		return(FPdunfl(reg, sign, v1exp, val1a, val1b, 53));
 
	VALH(d1) = sign | ((v1exp + DEXPBIAS) << 20) | (val1a & LO20BITS);
	VALL(d1) = val1b;
	machine.dreg[r1].dfracth = *pd1;
	machine.dreg[r1].dfractl = *(pd1+1);
	return(d1);

}  /* END, bscalbi */
