```-- Real.mesa

DIRECTORY
MiscAlpha,
Mopcodes USING [zMISC];

Real: DEFINITIONS =
BEGIN

-- 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];

-- Values that may be encountered as part of an exception.
-- You may want to use TrappingNaN to initialize storage.

NonTrappingNaN: LONG CARDINAL = LONG[1];
TrappingNaN: LONG CARDINAL = LONG[2];
MultiplyInfinityNaN: LONG CARDINAL = LONG[4];
DivideInfinityNaN: LONG CARDINAL = LONG[5];

-- 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, the client is expected to
-- return a fixed up copy of the reference or NIL, in
-- which case 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: POINTER TO Extended]
RETURNS [POINTER TO Extended];

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: 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).

-- ReadFloat needs to return the character after
-- the end of the number.

DefaultPutback: PROC [CHARACTER]; -- discards the character

get: PROC RETURNS [CHARACTER], putback: PROC [CHARACTER] ← DefaultPutback]
RETURNS [REAL];

StringToReal: PROC [STRING] RETURNS [REAL];

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

PairToReal: PROC [fr: LONG INTEGER, 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.

WriteReal: PROC [
cp: PROC [CHARACTER], r: REAL, precision: CARDINAL ← DefaultSinglePrecision,
forceE: BOOLEAN ← FALSE];

AppendReal: PROC [
s: STRING, r: REAL, precision: CARDINAL ← DefaultSinglePrecision,
forceE: BOOLEAN ← FALSE];

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

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

-- Operations

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

Fix: PROC [REAL] RETURNS [LONG INTEGER] = MACHINE CODE {
Mopcodes.zMISC, MiscAlpha.aFIX; };

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

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

-- These three Fixes round.

RoundLI: PROC [REAL] RETURNS [LONG INTEGER] = MACHINE CODE {
Mopcodes.zMISC, MiscAlpha.aROUND; };

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

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

-- Remainder of a/b.

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

-- These operations are normally generated by the compiler.

FAdd: PROC [a, b: REAL] RETURNS [REAL] = MACHINE CODE {

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

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

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

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

Float: PROC [LONG INTEGER] RETURNS [REAL] = MACHINE CODE
{Mopcodes.zMISC, MiscAlpha.aFLOAT; };

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

END.

```