DragonReal:
CEDAR
DEFINITIONS =
BEGIN
Real:
TYPE =
MACHINE
DEPENDENT
RECORD [
sign (0: 0.. 0): BOOL ← FALSE,
exp (0: 1.. 8): [0..400B) ← 0,
frac0 (0: 9..15): [0..200B) ← 0,
frac1 (0:16..31): CARDINAL ← 0];
RealDbl:
TYPE =
MACHINE
DEPENDENT
RECORD [
sign (0: 0.. 0): BOOL ← FALSE,
exp (0: 1..11): [0..4000B) ← 0,
frac0 (0:12..15): [0.. 20B) ← 0,
frac1 (0:16..31): CARDINAL ← 0,
frac2 (0:32..47): CARDINAL ← 0,
frac3 (0:48..63): CARDINAL ← 0];
Ext: TYPE = REF ExtRec;
ExtRec:
TYPE =
RECORD [
sign: BOOL ← FALSE,
type: NumberType ← normal,
double: BOOL ← FALSE,
sticky: BOOL ← FALSE,
exp: INTEGER ← 0,
sig: QCard.QCARD ← ALL[0]];
RoundType: TYPE = MACHINE DEPENDENT {nearest, zero, plus, minus};
NumberType: TYPE = {normal, zero, infinity, nan, integer, decimal};
QINT: TYPE = RECORD [sign: BOOL, val: QCard.QCARD];
RealFromINT: PROC [int: INT] RETURNS [Real];
RealDblFromQINT: PROC [int: QINT] RETURNS [RealDbl];
RealToINT: PROC [r: Real] RETURNS [type: NumberType, int: INT];
RealDblToQINT: PROC [r: RealDbl] RETURNS [type: NumberType, int: QINT];
RealFromDec: PROC [int: INT, exp10: INT] RETURNS [Real];
RealDblFromDec: PROC [int: QINT, exp10: INT] RETURNS [RealDbl];
RealToDec:
PROC [r:
REAL, precision:
NAT ← DefaultSinglePrecision]
RETURNS [type: NumberType, int: INT, exp10: INT];
RealDblToDec:
PROC [r: RealDbl, precision:
NAT ← DefaultDoublePrecision]
RETURNS [type: NumberType, int: QINT, exp10: INT];
A Decimal number is expressed as int * 10^exp10
DefaultSinglePrecision: CARDINAL = 7;
MaxSinglePrecision: CARDINAL = 9;
DefaultDoublePrecision: CARDINAL = 17;
MaxDoublePrecision: CARDINAL = 19;
The Real*FromDecimal routines may cause exceptions in the normal course of their work. In particular, InexactResult, Overflow, and Underflow. They always use `round to nearest'.
RealDblToINT and RealDblToDecimal routine may cause InexactResult.
BitOn:
PROC [a, b:
UNSPECIFIED]
RETURNS [
BOOLEAN] =
INLINE {
RETURN[PrincOpsUtils.BITAND[a, b] # 0]; };
Swaw:
PROC [r:
LONG
UNSPECIFIED]
RETURNS [
LONG
UNSPECIFIED] =
MACHINE
CODE {
PrincOps.zEXCH; };
So far, mostly copied from Real.mesa
See IEEE floating point standard for more information. Extended is the internal form of both single and double precision floating point numbers. 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). The integer and decimal types may go away if they don't prove useful. It was noticed that there really isn't that much difference in the required container size between RealDbl, QCARD, INTQ and a decimal integer/exp10 pair. Maybe something like ExtRec can serve as a more general 'BIG-NUMBER'.
Useful Real values
PlusZero: Real = [FALSE, 000B, 000B, 000000B];
MinusZero: Real = [TRUE, 000B, 000B, 000000B];
PlusInfinity: Real = [FALSE, 377B, 000B, 000000B];
MinusInfinity: Real = [TRUE, 377B, 000B, 000000B];
LargestNumber: Real = [FALSE, 376B, 177B, 177777B];
SmallestNormal: Real = [FALSE, 000B, 100B, 000000B];
NonTrappingNaN: Real = [FALSE, 377B, 000B, 000001B];
TrappingNaN: Real = [FALSE, 377B, 000B, 000002B]; -- storage initialization
Useful RealDbl values
PlusZeroDbl: RealDbl = [FALSE, 0000B, 00B, 000000B, 000000B, 000000B];
MinusZeroDbl: RealDbl = [TRUE, 0000B, 00B, 000000B, 000000B, 000000B];
PlusInfinityDbl: RealDbl = [FALSE, 3777B, 00B, 000000B, 000000B, 000000B];
MinusInfinityDbl: RealDbl = [TRUE, 3777B, 00B, 000000B, 000000B, 000000B];
LargestNumberDbl: RealDbl = [FALSE, 3776B, 17B, 177777B, 177777B, 177777B];
SmallestNormalDbl: RealDbl = [FALSE, 0000B, 10B, 000000B, 000000B, 000000B];
Useful QCARD values that may be encountered as Ext.qc during an exception.
TrapNonTrappingNaN: QCARD = [0,0,0,1];
TrapTrappingNaN: QCARD = [0,0,0,2];
AddInfinityNaN: QCARD = [0,0,0,3];
MultiplyInfinityNaN: QCARD = [0,0,0,4];
DivideInfinityNaN: QCARD = [0,0,0,5];
SqRtNaN: QCARD = [0,0,0,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.
GetStickyFlags: PROC RETURNS [ExceptionFlags];
SetStickyFlags:
PROC [new: ExceptionFlags ← NoExceptions]
RETURNS [old: ExceptionFlags];
RealError: ERROR;
RealException:
SIGNAL [flags: ExceptionFlags, vp:
REF Extended]
RETURNS [clientFixup: BOOLEAN ← FALSE];
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.
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;
These three Fixes truncate (round to integer in mode rz).
Fix: PROC [REAL] RETURNS [INT];
FixI: PROC [REAL] RETURNS [INTEGER];
FixC: PROC [REAL] RETURNS [CARDINAL];
These three Fixes round.
RoundLI: PROC [REAL] RETURNS [INT];
RoundI: PROC [REAL] RETURNS [INTEGER];
RoundC: PROC [REAL] RETURNS [CARDINAL];
FRem: PROC [a, b: REAL] RETURNS [REAL];
SqRt: PROC [REAL] RETURNS [REAL];
CompareREAL: PROC [a, b: REAL] RETURNS [Basics.Comparison];
These operations are normally generated by the compiler.
FAdd: PROC [a, b: REAL] RETURNS [REAL];
FSub: PROC [a, b: REAL] RETURNS [REAL];
FMul: PROC [a, b: REAL] RETURNS [REAL];
FDiv: PROC [a, b: REAL] RETURNS [REAL];
FComp: PROC [a, b: REAL] RETURNS [INTEGER];
Float: PROC [INT] RETURNS [REAL];
FScale:
PROC [a:
REAL, scale:
INTEGER]
RETURNS [
REAL];
END.