/* (C) Copyright International Business Machines Corporation 30 April */
/* 1991.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
/* Author: David F. Bacon and Bill Silverman */
#ifndef lint
static char sccsinfo[] = "@(#)chfunctions.c	1.2 6/26/91";
#endif

#include "ops.h"
#include "storage.h"
#include "sysdep.h"

#define signbit(i) ((i) & SIGNBIT)
                                /* returns 0 if positive or 0, non-zero if */
                                /*  negative. */

#define init_integer(objectp, val) \
  (set_init((objectp), dr_integer), (objectp)->value.integer = (val))


extern datarep dr_integer, dr_real;


int chf_iadd(result, int1, int2)
  objectp result;
  int int1, int2;
{
    register int s1, s2;
    s1 = int1;			/* get operands... */
    s2 = int2;

    if (s2 >= 0) {		/* then this is addition */
	if (s1 > MAXINT - s2)
	    return FALSE;	/* overflow */
    }
    else {			/* s2 is negative, so this is subtraction */
	if (s1 < MININT - s2) 
	    return FALSE;	/* overflow */
    }

    init_integer(result, s1 + s2); /* compute result and set tsdr */
    return TRUE;
}



int chf_isubtract(result, int1, int2)
  objectp result;
  int int1, int2;
{
    register int s1, s2;


    s1 = int1;			/* get operands... */
    s2 = int2;

    if (s2 >= 0) {		/* real subtraction */
	if (s1 < MININT + s2)
	    return FALSE;	/* overflow */
    }
    else {			/* this is really addition */ 
	if (s1 > MAXINT + s2)
	    return FALSE;	/* overflow */
    }

    init_integer(result, s1 - s2); /* compute result and set tsdr */
    return TRUE;
}


/* CONSTRAINT: s2 != 0 */
int chf_irem(result, int1, int2)
  objectp result;
  int int1, int2;
{
    register int s1, s2, d;

    s1 = int1;			/* get operands... */
    s2 = int2;

    d = s1 % s2;		/* get within |s2| of answer */

    /* result must be same sign as s1... in general C makes no */
    /* guarantee about the sign of d at this point */
    if (signbit(d) isnt signbit(s1) and d isnt 0)
      d += (signbit(d) is signbit(s2)) ? -s2 : s2;

    init_integer(result, d);
    return TRUE;
}


/* CONSTRAINT: s2 != 0 */
int chf_imod(result, int1, int2)
  objectp result;
  int int1, int2;
{
    register int s1, s2, d;

    s1 = int1;			/* get operands... */
    s2 = int2;

    d = s1 % s2;		/* get within |s2| of correct answer */
    
    /* result must be same sign as s2... in general C makes no */
    /* guarantee about the sign of d at this point */
    if (signbit(d) isnt signbit(s2) and d isnt 0)
      d += s2;

    init_integer(result, d);
    return TRUE;
}



int chf_imultiply(result, int1, int2)
  objectp result;
  int int1, int2;
{
    register int s1, s2;	/* operands */

    s1 = int1;			/* get operands.... */
    s2 = int2;

    if (s1 < 0) {
      if (s1 = MININT) {
        if (s2 != 1)
	  return FALSE;
      }
      else
	if (s2 < 0) {
	  if (s2 < MAXINT/s1)
	    return FALSE;
	}
	else
	  if (s2 > MININT/s1)
	    return FALSE;
    }
    else
      if (s1 != 0) {
	if (s2 < 0) {
	  if (s2 < MININT/s1)
	    return FALSE;
	}
	else
	  if (s2 > MAXINT/s1)
	    return FALSE;
      }
    init_integer(result, s1*s2);
    return TRUE;
}

/*
  These values were computed for the Sparc station, and may
  be incorrect for other platforms!
*/
#define MAXREAL 1.79769313486231580793728971405e+308
#define MINREAL -1.79769313486231580793728971405e+308

/*
   These values rely on truncation toward 0 and sufficient
   capacity in the double value to represent bounds exactly!
*/
#define REALINTUB (MAXINT + 1.0)
#define REALINTLB (MININT - 1.0)

#define init_real(objectp, val) \
  (set_init((objectp), dr_real), *((objectp)->value.real) = (val))

#define NewReal(Value) { \
    dfd_real *newreal; \
      if ((newreal = new(dfd_real)) is nil) { \
        return FALSE; \
      } \
      result->value.real = newreal; \
      init_real(result, Value); }

int chf_radd(result, real1, real2)
  objectp result;
  double real1, real2;
{
    register double s1, s2;

    s1 = real1;					/* get operands.... */
    s2 = real2;

    if (s2 >= 0.0) {		/* s2 is positive - is s1 too positive */
      if (s1 > MAXREAL - s2)
	return FALSE;				/* overflow */
    }
    else {			/* s2 is negative - is s1 too negative */
      if (s1 < MINREAL - s2)
	return FALSE;				/* overflow */
    }
    NewReal(s1 + s2);
    return TRUE;
}


int chf_rsubtract(result, real1, real2)
  objectp result;
  double real1, real2;
{
    register double s1, s2;

    s1 = real1;					/* get operands.... */
    s2 = real2;

    if (s2 >= 0.0) {		/* s2 is positive - is s1 too negative */
      if (s1 < MINREAL + s2)
	return FALSE;				/* overflow */
    }
    else {			/* s2 is negative - is s1 too positive */
      if (s1 > MAXREAL + s2)
	return FALSE;				/* overflow */
    }
    NewReal(s1 - s2);
    return TRUE;
}


int chf_rdivide(result, real1, real2)
  objectp result;
  double real1, real2;
{
    register double s1, s2;
    dfd_real *newreal;

    s1 = real1;					/* get operands.... */
    s2 = real2;

/* Comparisons to  ...REAL*s2  below check for quotient overflow when the
   divisor (s2) is a proper fraction. */

    if (s1 isnt 0) {
      if (s2 < 1.0) {
	if (-1.0 < s2) {
	  if (s2 > 0.0) {
	    if (s1 >= 0.0) {	/*  0.0 < s2 < 1.0  */
	      if (MAXREAL * s2 < s1)
		return FALSE;			/* overflow */
	    }
	    else {
	      if (MINREAL * s2 > s1)
		return FALSE;			/* overflow */
	    }
	  }
	  else {
	    if (s2 < 0.0) {	/* -1.0 < s2 < 0.0 */
	      if (s1 <= 0.0) {
		if (MAXREAL * s2 > s1)
		  return FALSE;			/* overflow */
	      }
	      else {
		if (MINREAL * s2 < s1)
		  return FALSE;			/* overflow */
	      }
	    }
	  }
	}
      }
      s1 = s1/s2;
      if (s1 is 0)
	return FALSE;				/* underflow */
    }

    NewReal(s1);
    return TRUE;
}


int chf_rmultiply(result, real1, real2)
  objectp result;
  double real1, real2;
{
    register double s1, s2;

    s1 = real1;				/* get operands.... */
    s2 = real2;

/* Comparisons to  ...REAL/s1  below check for product overflow when both
   factors are outside [-1, 1]. */

    if (s1 isnt 0) {
      if (s2 > 1.0) {
	if (s1 > 1.0) {
	  if (s1 > MAXREAL/s2)
	    return FALSE;			/* overflow */
	}
	else {
	  if (-1.0 >= s1) {
	    if (MINREAL/s2 > s1)
	      return FALSE;			/* overflow */
	  }
	}
      }
      else {
	if (s2 < -1.0) {
	  if (s1 > 1.0) {
	    if (s2 < MINREAL/s1)
	      return FALSE;			/* overflow */
	  }
	  else {
	    if (s1 < -1.0) {
	      if (s2 < MAXREAL/s1)
		return FALSE;			/* overflow */
	    }
	  }
	}
      }
      s1 = s1*s2;
      if (s1 is 0 and s2 isnt 0)
	return FALSE;			/* underflow */
    }
    NewReal(s1);
    return TRUE;
}

/*
** If storage macros are expanded inline in the interpreter, they
** must be defined as procedures to be called by the generated code.
*/

#ifndef NOINLINE
#undef getmain
generic *
getmain(size)
counter size;
{
  return GETMAIN(size);
}

#undef freemain
void freemain(stg, size)
generic *stg;
int size;
FREEMAIN((generic *) stg, size)
#endif
