/*
 * 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_FloatInt(i)
	INT32           i;
{
	float           retval = ((int) i);
	return (ToREAL32(retval));
};

/* FloatCard: PROC [c: CARD32] RETURNS [REAL32]; */
extern          REAL32
XR_FloatCard(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));
};

     
 ‌ت <  •NewlineDelimiter
™ Jڑœق!دcœûکي-— …—    î  2  