/*
* CompilerSingleReal.c - Note: compile this module with the switch
* "-fsingle" The routines in this file implement a portion of the interface
* between the Cedar compiler and the runtime support routines for the
* compiled code. If you are not writing the compiler, loader, makeboot, or
* the runtime initialization you shouldn't be looking at this file.
*/

/*
* last edited by Christian Jacobi, March 4, 1988 10:36:46 am PST last edited
* by Christian Jacobi, August 12, 1988 4:11:53 pm PDT
*/

/*
* REAL32 is a 32 bit quantity used internally by the Compiler to represent
* IEEE single precision floating point numbers [the Compiler used untyped
* operands and defines the type to be used with the operator]. As a
* consequence, this also prevents the C compiler from converting them to
* double precision. INT32 and CARD32 are the respective types used
* internally by the compiler to represent 32 bit sigened or unsgned
* integers.
*/

#include "CedarExtra.h"
#include <math.h>

typedef unsigned REAL32;
typedef unsigned INT32;
typedef unsigned CARD32;
typedef unsigned BOOLEAN;
#define TRUE 1
#define FALSE 0

/*
* These macros attempt to do LOOPHOLEs as opposed to C's cast. The
* difference is that no code is generated for a LOOPHOLE, while a cast can
* generate code. This implementation doesn't quite avoid code generation,
* but it comes close. Note that this module is compiled with the -fsingle
* switch to prevent casting floats into doubles.
*/

#define ToSingle(a) *(float *)(&a) /* single precision float from REAL32 */
#define ToREAL32(a) *(REAL32 *)(&a) /* REAL32 from a single float */

/* FloatInt: PROC [i: INT32] RETURNS [REAL32]; */
extern REAL32
XR𡤏loatInt(i)
 INT32 i;
{
 float retval = ((int) i);
 return (ToREAL32(retval));
};

/* FloatCard: PROC [c: CARD32] RETURNS [REAL32]; */
extern REAL32
XR𡤏loatCard(c)
 CARD32 c;
{
 float retval = c;
 return (ToREAL32(retval));
};

/* RealNeg: PROC [a: REAL32] RETURNS [REAL32]; */
extern REAL32
XR←RealNeg(a)
 REAL32 a;
{
 return (a ^ -2147483648); /* -2147483648 is 20000000000B */
};

/*
* RealAbs: PROC [a: REAL32] RETURNS [REAL32]; may re-evaluate arguments
*/
extern REAL32
XR←RealAbs(a)
 REAL32 a;
{
 return ((a << 1) >> 1);
};

/* RealAdd: PROC [a, b: REAL32] RETURNS [REAL32]; */
extern REAL32
XR←RealAdd(a, b)
 REAL32 a, b;
{
 float retval = ToSingle(a) + ToSingle(b);
 return (ToREAL32(retval));
};

/*
* RealSub: PROC [a, b: REAL32] RETURNS [REAL32]; (a-b)
*/
extern REAL32
XR←RealSub(a, b)
 REAL32 a, b;
{
 float retval = ToSingle(a) - ToSingle(b);
 return (ToREAL32(retval));
};


/* RealMul: PROC [a, b: REAL32] RETURNS [REAL32]; */
extern REAL32
XR←RealMul(a, b)
 REAL32 a, b;
{
 float retval = ToSingle(a) * ToSingle(b);
 return (ToREAL32(retval));
};

/*
* RealDiv: PROC [a, b: REAL32] RETURNS [REAL32]; (a/b)
*/
extern REAL32
XR←RealDiv(a, b)
 REAL32 a, b;
{
 float retval = ToSingle(a) / ToSingle(b);
 return (ToREAL32(retval));
};

/*
* RealMin: PROC [a, b: REAL32] RETURNS [REAL32]; may re-evaluate arguments
*/
extern REAL32
XR←RealMin(a, b)
 REAL32 a, b;
{
 float retval = (ToSingle(a) <= ToSingle(b) ? ToSingle(a) : ToSingle(b));
 return (ToREAL32(retval));
};

/*
* RealMax: PROC [a, b: REAL32] RETURNS [REAL32]; may re-evaluate arguments
*/
extern REAL32
XR←RealMax(a, b)
 REAL32 a, b;
{
 float retval = (ToSingle(a) >= ToSingle(b) ? ToSingle(a) : ToSingle(b));
 return (ToREAL32(retval));
};

/*
* RealGt: PROC [a, b: REAL32] RETURNS [BOOL]; (a>b)
*/
extern BOOLEAN
XR←RealGt(a, b)
 REAL32 a, b;
{
 return (ToSingle(a) > ToSingle(b) ? TRUE : FALSE);
};

/*
* RealGe: PROC [a, b: REAL32] RETURNS [BOOL]; (a>=b)
*/
extern BOOLEAN
XR←RealGe(a, b)
 REAL32 a, b;
{
 return (ToSingle(a) >= ToSingle(b) ? TRUE : FALSE);
};

/*
* RealEq: PROC [a, b: REAL32] RETURNS [BOOL]; (a=b)
*/
extern BOOLEAN
XR←RealEq(a, b)
 REAL32 a, b;
{
 return (ToSingle(a) == ToSingle(b) ? TRUE : FALSE);
};


static void
ErrorUndefined()
{
 /* this is not the right error */
 (void) XR←RaiseArithmeticFault();
};

/*
* SignedPwr: PROC [base, exp: INT32] RETURNS [INT32];
*/
extern INT32
XR←SignedPwr(base, exp)
 INT32 base, exp;
{
 int p = 1;
 int b = (int) base;
 int e = (int) exp;
 switch (b) {
 case 0:
  if (e <= 0)
   (void) ErrorUndefined();
  return ((INT32) 0);
 case 1:
  return ((INT32) 1);
 case -1:
  if (e & 1)
   return ((INT32) - 1);
  else
   return ((INT32) 1);
 default:
  break;
 };
 if (e < 0)
  return ((INT32) 0);
 /* invariant: p * b**e = base**exp */
 while (1) {
  if (e & 1) {
   p *= b;
   e -= 1;
  };
  if (e) {
   b *= b;
   e /= 2;
  } else {
   if (base)
    return ((INT32) p);
   (void) ErrorUndefined();
  };
 };
};


/*
* UnsignedPwr: PROC [base, exp: CARD32] RETURNS [CARD32];
*/
extern CARD32
XR←UnsignedPwr(base, exp)
 CARD32 base, exp;
{
 unsigned p = 1;
 unsigned b = (unsigned) base;
 unsigned e = (unsigned) exp;
 /* invariant: p * b**e = base**exp */
 while (1) {
  if (e & 1) {
   p *= b;
   e -= 1;
  };
  if (e) {
   b *= b;
   e /= 2;
  } else {
   if (base)
    return ((CARD32) p);
   (void) ErrorUndefined();
  };
 };
};

/*
* RealPwr: PROC [base, exp: REAL32] RETURNS [REAL32];
*/
extern REAL32
XR←RealPwr(base, exp)
 REAL32 base, exp;
{
 float e = ToSingle(exp);
 float b = ToSingle(base);
 double ee = e;
 double bb = b;
 double p = pow(bb, ee);
 e = p;   /* down to single precision */
 return (ToREAL32(e));
};