<> <> <> <> <> <> <> DIRECTORY Basics USING [BITAND, BITOR, BITSHIFT, DoubleShift, DoubleShiftRight, LongMult, LongNumber], Ieee USING [ADC3, BitOn, DenormalizedExponent, Details, ExponentBias, ExpSingleMax, ExpSingleMin, Ext, FractionShift, HiBit, HiddenBit, HiFractionMask, LargestSignificand, LeastSignificandBit, Microcode, MicroSticky, NaNExponent, SingleReal, StickyBits], Real USING [Exception, ExceptionFlags, Extended, MinusInfinity, MinusZero, NoExceptions, PlusInfinity, PlusZero, RealException, TrapNonTrappingNaN, TrapTrappingNaN], RealExceptions USING [GetExceptions, SetException, SetSticky, TestException], RealOps USING [GetMode, Mode]; IeeeUtil: CEDAR PROGRAM IMPORTS Basics, Ieee, Real, RealExceptions, RealOps EXPORTS Ieee = BEGIN OPEN Ieee, Real; LongNumber: TYPE = Basics.LongNumber; <> <> <> <> NormalizedCardinal: PROC [g: CARDINAL] RETURNS [BOOL] = TRUSTED INLINE { RETURN [Basics.BITAND[g, Ieee.HiddenBit] # 0]; }; SetInexactResult: PUBLIC PROC = { RealExceptions.SetException[inexactResult]; }; SetInvalidOperation: PUBLIC PROC = { RealExceptions.SetException[invalidOperation]; }; SetDivisionByZero: PUBLIC PROC = { RealExceptions.SetException[divisionByZero]; }; SetUnderflow: PUBLIC PROC [z: POINTER TO Ext] = { RealExceptions.SetException[underflow]; }; SetOverflow: PUBLIC PROC [z: POINTER TO Ext] = { RealExceptions.SetException[overflow]; }; SetFixOverflow: PUBLIC PROC = { RealExceptions.SetException[fixOverflow]; RealExceptions.SetSticky[fixOverflow]; }; <> Unpack: PUBLIC PROC [r: REAL] RETURNS [z: Ext] = TRUSTED { single: Ieee.SingleReal _ LOOPHOLE[r]; exp: INTEGER _ LOOPHOLE[single.exp, INTEGER] - ExponentBias; z.exp _ exp; z.det.sticky _ FALSE; z.det.sign _ BitOn[LOOPHOLE[r, LongNumber].highbits, HiBit]; -- first r.j. the exponent z.det.type _ normal; z.frac.li _ LOOPHOLE[r, INT]; z.frac.highbits _ Basics.BITAND[HiFractionMask, z.frac.highbits]; SELECT exp FROM = DenormalizedExponent => { <> IF z.frac.li = 0 THEN z.det.type _ zero ELSE { z.exp _ ExpSingleMin; z.frac _ Basics.DoubleShift[z.frac, FractionShift]; PostNormalize[@z]; <> <> }; }; = NaNExponent => { <> IF z.frac.li = 0 THEN z.det.type _ infinity ELSE { z.det.type _ nan; IF z.frac.lc = Real.TrapTrappingNaN THEN SetInvalidOperation[]; }; }; ENDCASE => { z.frac _ Basics.DoubleShift[z.frac, FractionShift]; z.frac.highbits _ Basics.BITOR[HiddenBit, z.frac.highbits]; }; }; <> Pack: PUBLIC PROC [z: POINTER TO Ext] RETURNS [r: REAL] = TRUSTED { trap: BOOL _ FALSE; i: Exception; exceptions: Real.ExceptionFlags _ RealExceptions.GetExceptions[]; IF exceptions # NoExceptions THEN { <> <> <> <> <<};>> mode: RealOps.Mode _ RealOps.GetMode[]; FOR i IN Exception DO IF exceptions[i] THEN { RealExceptions.SetSticky[i]; IF mode.traps[i] THEN trap _ TRUE; IF i = invalidOperation THEN { z.det.type _ nan; IF z.frac.lc = 0 THEN z.frac.lc _ TrapNonTrappingNaN; }; }; ENDLOOP; IF trap THEN { p: REF Extended _ NEW[Extended _ CVExtended[z^]]; clientFix: BOOL _ SIGNAL Real.RealException[flags: RealExceptions.GetExceptions[], vp: p]; IF NOT clientFix THEN FixupProcedure[z] ELSE CFExtended[p, z]; } ELSE FixupProcedure[z]; }; RETURN[UsualPack[z^]]; }; UsualPack: PUBLIC PROC [z: Ext] RETURNS [REAL] = TRUSTED { single: Ieee.SingleReal; exp: INTEGER _ z.exp; SELECT z.det.type FROM zero => RETURN [IF z.det.sign THEN Real.MinusZero ELSE Real.PlusZero]; infinity => RETURN [IF z.det.sign THEN Real.MinusInfinity ELSE Real.PlusInfinity]; nan => z.exp _ NaNExponent; ENDCASE => z.frac _ Basics.DoubleShift[z.frac, -FractionShift]; SELECT exp FROM < - ExponentBias => RETURN [IF z.det.sign THEN Real.MinusZero ELSE Real.PlusZero]; <> > ExponentBias+1 => RETURN [IF z.det.sign THEN Real.MinusInfinity ELSE Real.PlusInfinity]; <> ENDCASE; <> single _ LOOPHOLE[z.frac.real]; <> single.exp _ exp+ExponentBias; <> single.sign _ z.det.sign; <> RETURN[LOOPHOLE[single]]; }; FixupProcedure: PUBLIC PROC [vp: POINTER TO Ext] = TRUSTED { IF RealExceptions.TestException[underflow] THEN { DeNormalize[vp, vp.exp - ExpSingleMin]; vp.exp _ DenormalizedExponent; Round[vp]; IF vp.exp # DenormalizedExponent THEN { vp.frac _ RShift[vp.frac]; vp.exp _ DenormalizedExponent; }; }; IF RealExceptions.TestException[overflow] THEN { RealExceptions.SetSticky[inexactResult]; SELECT RealOps.GetMode[].round FROM rn, rz => GOTO SignTest; rp => IF NOT vp.det.sign THEN GOTO SignTest; rm => IF vp.det.sign THEN GOTO SignTest; ENDCASE => ERROR; IF NormalizedCardinal[vp.frac.highbits] THEN vp.frac.lc _ LargestSignificand; vp.exp _ ExpSingleMax; EXITS SignTest => vp.det.type _ infinity; }; }; Round: PUBLIC PROC [z: POINTER TO Ext] = TRUSTED { temp: LONG CARDINAL; <