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 Fix: PROC [REAL] RETURNS [INT] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFIX; }; FixLI: 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; }; Round: PROC [REAL] RETURNS [INT] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aROUND; }; 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; }; CompareREAL: PROC [a, b: REAL] RETURNS [Basics.Comparison] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFCOMP; PrincOps.zINC; }; SqRt: PROC [REAL] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFSQRT; }; FRem: PROC [a, b: REAL] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFREM; }; FAdd: PROC [a, b: REAL] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFADD; }; -- a+b FSub: PROC [a, b: REAL] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFSUB; }; -- a-b FMul: PROC [a, b: REAL] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFMUL; }; -- a*b FDiv: PROC [a, b: REAL] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFDIV; }; -- a/b FComp: PROC [a, b: REAL] RETURNS [INTEGER] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFCOMP; }; -- (a -1, (a=b) => 0, (a>b) => +1 FScale: PROC [a: REAL, scale: INTEGER] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFSC; }; -- a*(2^scale) Float: PROC [i: INT] RETURNS [REAL] = TRUSTED MACHINE CODE { PrincOps.zMISC, PrincOps.aFLOAT; }; -- REAL[i] MaxSinglePrecision: CARDINAL = 9; DefaultSinglePrecision: CARDINAL = 7; PairToReal: PROC [fr: INT, exp10: INTEGER] RETURNS [REAL]; RealToPair: PROC [r: REAL, precision: NAT _ DefaultSinglePrecision] RETURNS [type: NumberType, fr: INT, exp10: INTEGER]; 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]; NonTrappingNaN: REAL = LOOPHOLE[17740000001B]; TrappingNaN: REAL = LOOPHOLE[17740000002B]; 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]; Flag: TYPE = BOOL _ 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 ]; NumberType: TYPE = MACHINE DEPENDENT { normal, zero, infinity, nan }; Extended: TYPE = RECORD [ type: NumberType, sign: BOOL, exp: INTEGER, frac: LONG CARDINAL ]; RealException: SIGNAL [flags: ExceptionFlags, vp: REF Extended] RETURNS [clientFixup: BOOL _ FALSE]; RealError: ERROR; GetStickyFlags: PROC RETURNS [ExceptionFlags]; SetStickyFlags: PROC [new: ExceptionFlags _ NoExceptions] RETURNS [old: ExceptionFlags]; END. ์Real.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Stewart, September 1, 1982 10:03 am Rovner, May 13, 1983 1:13 pm Levin, August 8, 1983 4:15 pm Russ Atkinson (RRA) February 19, 1985 5:03:31 pm PST Doug Wyatt, February 25, 1985 3:25:02 pm PST Operations on REAL numbers. See IEEE floating point standard for more information. Operations ... converts REAL to INT by truncating (mode rz). ... same as Fix (LI stands for LONG INTEGER). ... converts REAL to INTEGER by truncating (mode rz). ... converts REAL to CARDINAL by truncating (mode rz). ... converts REAL to INT by rounding (mode rn). ... same as Round (LI stands for LONG INTEGER). ... converts REAL to INTEGER by rounding (mode rn). ... converts REAL to CARDINAL by rounding (mode rn). ... compares two REALs. Square root. Note that RealFns.SqRt is probably faster. Remainder of a/b. Caution: this is currently unimplemented! The following are normally generated by the compiler. Decimal conversion # of decimal places needed to always exactly reproduce the given real number. # of decimal places that are normally fully significant ... converts the value fr*10**exp10 to real. ... converts value r to fr*10**exp10; fr will have precision significant digits. Constants You may want to use TrappingNaN to initialize storage. These values may be encountered as vp.frac during an exception. Exceptions 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 type = nan, then exp is undefined and frac contains the nan significand. Some constant nans are defined above. If type = 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). RealException 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. 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. 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 Russ Atkinson (RRA) February 19, 1985 5:02:31 pm PST General cleanup, especially to improve readability Doug Wyatt, February 25, 1985 2:17:58 pm PST More cleanup. Removed initialization stuff. สฎ˜codešœ ™ Kšœ ฯmœ1™Kšœ!˜!Kšœ˜Kšœ žœžœ™3K˜—š œžœžœžœžœžœžœžœ˜?Kšœ!˜!Kšœ˜Kšœ žœžœ™4K˜—K˜š  œžœžœžœžœžœžœ˜SKšœ ˜ Kšœ˜Kšœ˜Kšœžœ™K˜—š œžœžœžœžœžœžœžœ˜9Kšœ ˜ Kšœ˜Kšœ8™8K™—š œžœžœžœžœžœžœžœ˜?Kšœ˜Kšœ˜Kšœ<™K™:™4Kšœ2™2—™,K™,—K™K™—…—$ธ