-- Real.mesa
-- Last Modified: September 29, 1980  12:27 AM
-- Copyright Xerox Corporation 1980

DIRECTORY
  MiscAlpha,
  Mopcodes USING [zMISC];

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

  -- 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];
  AddInfinityNaN: LONG CARDINAL = LONG[3];
  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

  ReadReal: PROC [
    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 {
    Mopcodes.zMISC, MiscAlpha.aFADD; };

  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.