DIRECTORY BitOps, Dragon, IO, QCard; 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]; DefaultSinglePrecision: CARDINAL = 7; MaxSinglePrecision: CARDINAL = 9; DefaultDoublePrecision: CARDINAL = 17; MaxDoublePrecision: CARDINAL = 19; 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; }; 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 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]; 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]; 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]; 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]; InitReals: PROC; RealControl: UNSAFE PROGRAM; Fix: PROC [REAL] RETURNS [INT]; FixI: PROC [REAL] RETURNS [INTEGER]; FixC: PROC [REAL] RETURNS [CARDINAL]; 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]; 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. ╞DragonReal.mesa Copyright c 1984 by Xerox Corporation. All rights reserved. Last edited by Curry, February 4, 1985 11:02:24 pm PST A Decimal number is expressed as int * 10^exp10 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. 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 Useful RealDbl values Useful QCARD values that may be encountered as Ext.qc during an exception. Exceptions 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. 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. These three Fixes truncate (round to integer in mode rz). These three Fixes round. These operations are normally generated by the compiler. Э╩жШЪ╨blЩJЪЬ ╧mЬ1ЩЩJJЪЬЯЬ Ш&JЪЬЯЬ Ш$JЪЬЯЬ Ш#JЪЬЯЬ Ш'JЪЬЯЬ Ш&JЪЬ ЯЬ ШJШЧЪа Щ JШJЪЬЯЬЯЬЯЬШJШЪЬЯЬЯЬЯ ЬШ$JШJШJШJШJШ JШJШЧJЪ ЬЯЬЯЬЯЬЯЬШ6JШJЪЬЯЬЯЬШ*JЪЬ ЯЬЯЬШ*Ш!JЪ ЬЯЬЯЬЯЬЯЬШRJШЧJЪЬшЩшJШJЪвЬЯЬЯЬШ.ЪвЬЯЬ%Ш9JЪЯЬШJШЧJЪа ЬЯЬШЪа ЬЯЬЯЬ Ш?JЪЯЬЯЬЯЬШ'ЧJЩJЪЬНЩНJЩJЩЧЪЭЩJШJЪЬ1Щ1JЪЬ5Щ5JЪЬ.Щ.JЪЬЩJШJЪв ЬЯЬШJЪаЬЯЬЯЬШJШJШЪЬ;Щ;JЪ вЬЯЬЯЬЯЬЯЬШJЪ вЬЯЬЯЬЯЬЯЬШ$JЪ вЬЯЬЯЬЯЬЯЬШ%JШЧЪЬЩJЪ вЬЯЬЯЬЯЬЯЬШ#JЪ вЬЯЬЯЬЯЬЯЬШ&JЪ вЬЯЬЯЬЯЬЯЬШ'JШJЪ вЬЯЬЯЬЯЬЯЬШ'JЪ вЬЯЬЯЬЯЬЯЬШ!JЪвЬЯЬЯЬЯЬШ;JШЧЪЬ9Щ9JШJЪ вЬЯЬЯЬЯЬЯЬШ(JЪ вЬЯЬЯЬЯЬЯЬШ'JЪ вЬЯЬЯЬЯЬЯЬШ'JЪ вЬЯЬЯЬЯЬЯЬШ'JЪ вЬЯЬЯЬЯЬЯЬШ+JЪ вЬЯЬЯЬЯЬЯЬШ"ЪвЬЯЬЯЬ ЯЬЯЬЯЬШ6JШЧJШЧЧJЪЯЬШJШЧJШЧЕЧ*#Ц