<> <> <> <> <> DIRECTORY Basics USING [LongMult, LongNumber], IeeeInternal, PrincOps, PrincOpsUtils, Real, RealOps USING [DefMode, Mode]; DragonRealIeeeD: CEDAR PROGRAM IMPORTS Basics, IeeeInternal, PrincOpsUtils, Real EXPORTS IeeeInternal = BEGIN OPEN IeeeInternal, Real; <> fpmode: PUBLIC RealOps.Mode _ RealOps.DefMode; thisTimeExceptions: PUBLIC Real.ExceptionFlags _ Real.NoExceptions; stickyFlags: PUBLIC Real.ExceptionFlags _ Real.NoExceptions; SetInexactResult: PUBLIC PROC = {thisTimeExceptions[inexactResult] _ TRUE; }; SetInvalidOperation: PUBLIC PROC = { thisTimeExceptions[invalidOperation] _ TRUE; }; SetDivisionByZero: PUBLIC PROC = {thisTimeExceptions[divisionByZero] _ TRUE; }; SetUnderflow: PUBLIC PROC [z: POINTER TO Ext] = { thisTimeExceptions[underflow] _ TRUE; }; SetOverflow: PUBLIC PROC [z: POINTER TO Ext] = { thisTimeExceptions[overflow] _ TRUE; }; SetFixOverflow: PUBLIC PROC = { thisTimeExceptions[fixOverflow] _ TRUE; stickyFlags[fixOverflow] _ TRUE; }; <> Unpack: PUBLIC PROC [r: REAL] RETURNS [z: Ext] = TRUSTED { z.det.sticky _ FALSE; z.det.sign _ BitOn[LN[r].highbits, HiBit]; -- first r.j. the exponent z.exp _ PrincOpsUtils.BITSHIFT[ PrincOpsUtils.BITAND[LN[r].highbits, ExponentMask], -ExponentShift]; z.exp _ z.exp - ExponentBias; z.det.type _ normal; z.frac.li _ LN[r].li; z.frac.highbits _ PrincOpsUtils.BITAND[HiFractionMask, z.frac.highbits]; SELECT z.exp FROM = DenormalizedExponent => { <> IF z.frac.li = 0 THEN z.det.type _ zero ELSE { z.exp _ ExpSingleMin; z.frac.li _ LongShift[z.frac.li, FractionShift]; IF fpmode.nm = normalizing THEN 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.li _ LongShift[z.frac.li, FractionShift]; z.frac.highbits _ PrincOpsUtils.BITOR[HiddenBit, z.frac.highbits]; }; }; <> Pack: PUBLIC PROC [z: POINTER TO Ext] RETURNS [r: REAL] = TRUSTED { trap: BOOLEAN _ FALSE; p: REF Extended _ NIL; clientFix: BOOL; i: Exception; IF thisTimeExceptions # NoExceptions THEN { <> <> <> <> <<};>> IF thisTimeExceptions[invalidOperation] THEN { z.det.type _ nan; IF z.frac.lc = 0 THEN z.frac.lc _ TrapNonTrappingNaN; }; FOR i IN Exception DO stickyFlags[i] _ stickyFlags[i] OR thisTimeExceptions[i]; trap _ trap OR (fpmode.traps[i] AND thisTimeExceptions[i]); ENDLOOP; IF trap THEN { p _ NEW[Extended _ CVExtended[z^]]; clientFix _ SIGNAL Real.RealException[flags: thisTimeExceptions, 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 { 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.li _ LongShift[z.frac.li, -FractionShift]; <