-- Real.mesa
-- Last Modified: L. Stewart, September 1, 1982 10:03 am
-- Last Modified: Paul Rovner, May 13, 1983 1:13 pm
-- Last Edited by: Levin, August 8, 1983 4:15 pm

DIRECTORY
Basics USING [Comparison],
PrincOps USING [zINC, zMISC, aFIX, aFIXI, aFIXC, aROUND, aROUNDI, aROUNDC, aFREM, aFSQRT, aFCOMP, aFADD, aFSUB, aFMUL, aFDIV, aFLOAT, aFSC];

Real: CEDAR DEFINITIONS =
BEGIN

-- See IEEE floating point standard for more information.

-- Extended is the internal form of a single precision
-- floating point number. If the type of a value is
-- infinity or zero, only the sign is interesting.
-- In these cases, exp and frac are undefined.
-- If spec = nan, then exp is undefined and frac
-- contains the nan significand. Some constant
-- nans are defined below. If spec is normal,
-- then sign, exp, and frac describe the value.
-- If sign is true, then the number is negative.
-- Exp is the binary exponent. Frac is the significand
-- (the binary point is between bits 0 and 1 -
-- normalized numbers are between 1 and 2).

NumberType: TYPE = MACHINE DEPENDENT{normal, zero, infinity, nan};

Extended: TYPE = RECORD [
type: NumberType, sign: BOOLEAN, exp: INTEGER, frac: LONG CARDINAL];

-- Constants

-- Useful REAL values.
PlusZero: REAL = LOOPHOLE[LONG[00000000000B]];
MinusZero: REAL = LOOPHOLE[20000000000B];
PlusInfinity: REAL = LOOPHOLE[17740000000B];
MinusInfinity: REAL = LOOPHOLE[37740000000B];
LargestNumber: REAL = LOOPHOLE[17737777777B]; -- almost infinity
SmallestNormalizedNumber: REAL = LOOPHOLE[00040000000B];

-- You may want to use TrappingNaN to initialize storage.

NonTrappingNaN: REAL = LOOPHOLE[17740000001B];
TrappingNaN: REAL = LOOPHOLE[17740000002B];

-- Values that may be encountered as vp.frac during an exception.

TrapNonTrappingNaN: LONG CARDINAL = LONG[1];
TrapTrappingNaN: LONG CARDINAL = LONG[2];
AddInfinityNaN: LONG CARDINAL = LONG[3];
MultiplyInfinityNaN: LONG CARDINAL = LONG[4];
DivideInfinityNaN: LONG CARDINAL = LONG[5];
SqRtNaN: LONG CARDINAL = LONG[6];

-- Exceptions
Flag: TYPE = BOOLEAN ← FALSE;

Exception: TYPE = MACHINE DEPENDENT{
fixOverflow, inexactResult, invalidOperation, divisionByZero, overflow,
underflow};

ExceptionFlags: TYPE = PACKED ARRAY Exception OF Flag;

NoExceptions: ExceptionFlags = ALL[FALSE];
AllExceptions: ExceptionFlags = ALL[TRUE];
UsualExceptions: ExceptionFlags =
[fixOverflow: TRUE, invalidOperation: TRUE, divisionByZero: TRUE,
overflow: TRUE];

-- The six kinds of exceptions have independent
-- "sticky" flags that remember if the exception
-- has occurred since the last call to SetStickyFlags.
-- SetStickyFlags is provided so that procedures may
-- save and restore the state for others.

SetStickyFlags: PROC [new: ExceptionFlags ← NoExceptions]
RETURNS [old: ExceptionFlags];

GetStickyFlags: PROC RETURNS [ExceptionFlags];

-- This signal is raised if any enabled exception occurs.
-- Flags reports all the exceptions which occurred during
-- the faulted operation (including those which are
-- disabled). On RESUME, if clientFixup is TRUE, the client is
-- expected to have fixed up the reference. If clientFixup is
-- FALSE the standard fixup will happen. Operations
-- in this interface only raise RealException on the
-- conditions mentioned in UsualExceptions, above.
-- Usually, RealException can be resumed, but certain
-- exceptions, such as invalidOperation raised as a
-- result of compare or one of the Fixes, cannot be
-- resumed. If a RESUME is done in such a case, the
-- ERROR RealError is raised.

RealException: SIGNAL [flags: ExceptionFlags, vp: REF Extended]
RETURNS [clientFixup: BOOLEAN ← FALSE];

RealError: ERROR;

-- INITIALIZATION

-- The procedure InitReals must be called before any
-- floating point operations are called. Alternatively,
-- RealControl must be STARTed. It is ok to call
-- InitReals more than once.

InitReals: PROC;
RealControl: UNSAFE PROGRAM;

MaxSinglePrecision: CARDINAL = 9;
DefaultSinglePrecision: CARDINAL = 7;

-- The decimal to binary routines may cause exceptions
-- in the normal course of their work. In particular,
-- InexactResult, Overflow, and Underflow. They
-- always use rounding mode rn (round to nearest).

-- PairToReal converts the value fr*10**exp10 to real.

PairToReal: PROC [fr: INT, exp10: INTEGER] RETURNS [REAL];

-- The binary to decimal routines will not cause
-- exceptions. The decimal output is rounded to
-- precision significant digits in rounding mode rn.
-- ForceE ← TRUE forces output in scientific notation.

-- Real to Pair converts value r to fr*10**exp10.
-- fr will have precision significant digits.

RealToPair: PROC [r: REAL, precision: NAT ← DefaultSinglePrecision]
RETURNS [type: NumberType, fr: INT, exp10: INTEGER];

-- Operations

-- These three Fixes truncate (round to integer in mode rz).

Fix: PROC [REAL] RETURNS [INT] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFIX; };

FixI: PROC [REAL] RETURNS [INTEGER] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFIXI; };

FixC: PROC [REAL] RETURNS [CARDINAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFIXC; };

-- These three Fixes round.

RoundLI: PROC [REAL] RETURNS [INT] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aROUND; };

RoundI: PROC [REAL] RETURNS [INTEGER] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aROUNDI; };

RoundC: PROC [REAL] RETURNS [CARDINAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aROUNDC; };

-- Remainder of a/b.

FRem: PROC [a, b: REAL] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFREM; };

-- Square Root.

SqRt: PROC [REAL] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFSQRT; };

-- Basics.Comparison style compare

CompareREAL: PROC [a, b: REAL] RETURNS [Basics.Comparison] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFCOMP; PrincOps.zINC; };

-- These operations are normally generated by the compiler.

FAdd: PROC [a, b: REAL] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFADD; };

FSub: PROC [a, b: REAL] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFSUB; };

FMul: PROC [a, b: REAL] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFMUL; };

FDiv: PROC [a, b: REAL] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFDIV; };

FComp: PROC [a, b: REAL] RETURNS [INTEGER] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFCOMP; };

Float: PROC [INT] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFLOAT; };

FScale: PROC [a: REAL, scale: INTEGER] RETURNS [REAL] =
TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFSC; };

Microcode: BOOLEAN = TRUE;
-- For use by the implementation

END.
4-Feb-81 18:42:11, L. Stewart, fixed TrappingNaN to be of type REAL
June 3, 1982 10:36 am, L. Stewart, added REF, SqRt, FScale, removed STRING
September 1, 1982 10:03 am, L. Stewart, CompareREAL, Cedar 3.4
May 13, 1983 1:13 pm, Paul Rovner, conversion to Cedar 5.0