DIRECTORY Basics USING [LongMult, LongNumber], IeeeInternal, PrincOps, PrincOpsUtils, Real, RealOps USING [DefMode, Mode]; IeeeUtil: 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]; z.frac.highbits _ PrincOpsUtils.BITAND[z.frac.highbits, HiFractionMask]; IF z.exp NOT IN [-127..128] THEN ERROR; z.exp _ PrincOpsUtils.BITSHIFT[z.exp + ExponentBias, ExponentShift]; z.frac.highbits _ PrincOpsUtils.BITOR[z.frac.highbits, z.exp]; IF z.det.sign THEN z.frac.highbits _ PrincOpsUtils.BITOR[z.frac.highbits, SignBit]; RETURN[LOOPHOLE[z.frac.li, REAL]]; }; FixupProcedure: PUBLIC PROC [vp: POINTER TO Ext] = TRUSTED { IF thisTimeExceptions[underflow] THEN { DeNormalize[vp, vp.exp - ExpSingleMin]; vp.exp _ DenormalizedExponent; Round[vp]; IF vp.exp # DenormalizedExponent THEN { vp.frac.lc _ RShift[vp.frac.lc]; vp.exp _ DenormalizedExponent; }; }; IF thisTimeExceptions[overflow] THEN { stickyFlags[inexactResult] _ TRUE; SELECT fpmode.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 IeeeInternal.Normalized[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; GRS: PUBLIC PROC [g: CARDINAL] RETURNS [INTEGER] = TRUSTED { s: BOOLEAN _ BitOn[g, StickyBits] OR z.det.sticky; g _ PrincOpsUtils.BITSHIFT[PrincOpsUtils.BITAND[g, 300B], -5]; IF s THEN g _ g + 1; RETURN[g]; }; -- The fraction should be normalized here! grs: INTEGER _ GRS[z.frac.lowbits]; IF grs = 0 THEN RETURN; SetInexactResult[]; { SELECT fpmode.round FROM rn => IF grs > 4 OR (grs = 4 AND BitOn[z.frac.lowbits, LeastSignificandBit]) THEN GOTO Plus1; rz => NULL; rm => IF z.det.sign THEN GOTO Plus1; rp => IF NOT z.det.sign THEN GOTO Plus1; ENDCASE => ERROR; EXITS Plus1 => { temp _ z.frac.lc; z.frac.lc _ z.frac.lc + LeastSignificandBit; IF z.frac.lc <= temp THEN { z.frac.li _ RShift1in1[z.frac.li]; z.exp _ z.exp + 1; }; }; }; }; RShift1in1: PUBLIC PROC [z: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = TRUSTED { vl: Basics.LongNumber; vl.lc _ z; vl.lc _ vl.lc/2; vl.highbits _ PrincOpsUtils.BITOR[HiddenBit, vl.highbits]; RETURN[vl.lc]; }; NormalType: PUBLIC PROC [x, y: Details] RETURNS [INTEGER] = TRUSTED { RETURN[(LOOPHOLE[x.type, INTEGER]*2) + LOOPHOLE[y.type, INTEGER]]; }; RShift: PUBLIC PROC [z: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = TRUSTED { z _ LOOPHOLE[z, LONG CARDINAL]/2; RETURN[z]; }; LShift: PUBLIC PROC [z: LONG UNSPECIFIED] RETURNS [LONG UNSPECIFIED] = TRUSTED { z _ LOOPHOLE[z, LONG CARDINAL]*2; RETURN[z]; }; StepTwo: PUBLIC PROC [z: POINTER TO Ext] = TRUSTED { IF z.det.type # normal THEN RETURN; IF z.exp <= ExpSingleMin THEN { IF z.exp < ExpSingleMin OR (NOT Normalized[z.frac.highbits]) THEN SetUnderflow[z]; }; IF NOT thisTimeExceptions[underflow] THEN Round[z]; IF (NOT Normalized[z.frac.highbits]) AND z.exp # DenormalizedExponent AND (NOT thisTimeExceptions[underflow]) THEN SetInvalidOperation[] ELSE IF z.exp > ExpSingleMax THEN SetOverflow[z]; }; Mul32: PUBLIC PROC [x, y: Basics.LongNumber] RETURNS [Basics.LongNumber, Basics.LongNumber] = TRUSTED { hi, lo, t1, t2: Basics.LongNumber; cy: CARDINAL; lo.lc _ Basics.LongMult[x.lowbits, y.lowbits]; hi.lc _ Basics.LongMult[x.highbits, y.highbits]; t1.lc _ Basics.LongMult[x.highbits, y.lowbits]; t2.lc _ Basics.LongMult[x.lowbits, y.highbits]; [cy, lo.highbits] _ IeeeInternal.ADC3[lo.highbits, t1.lowbits, t2.lowbits]; hi.lc _ hi.lc + t1.highbits + t2.highbits + cy; RETURN[hi, lo]; }; PostNormalize: PUBLIC PROC [z: POINTER TO Ext] = TRUSTED { IF z.frac.lc = 0 THEN ERROR; WHILE NOT IeeeInternal.BitOn[z.frac.highbits, HiddenBit] DO z.frac.lc _ LShift[z.frac.lc]; z.exp _ z.exp - 1; ENDLOOP; }; LongShift: PUBLIC PROC [z: LONG UNSPECIFIED, count: INTEGER] RETURNS [LONG UNSPECIFIED] = TRUSTED { vl: Basics.LongNumber; vl.lc _ z; IF count >= 0 THEN THROUGH [0..count) DO vl.lc _ vl.lc*2; ENDLOOP ELSE THROUGH (count..0] DO vl.lc _ vl.lc/2; ENDLOOP; RETURN[vl.lc]; }; DeNormalize: PUBLIC PROC [z: POINTER TO Ext, count: INTEGER] = TRUSTED { b: BOOLEAN _ FALSE; IF count > 0 THEN ERROR; THROUGH (count..0] DO b _ b OR BitOn[z.frac.lowbits, 1]; z.frac.lc _ z.frac.lc/2; ENDLOOP; IF b OR z.det.sticky THEN { z.frac.lowbits _ PrincOpsUtils.BITOR[z.frac.lowbits, 1]; z.det.sticky _ FALSE; }; }; CVExtended: PUBLIC PROC [z: IeeeInternal.Ext] RETURNS [Real.Extended] = TRUSTED { RETURN[[type: z.det.type, sign: z.det.sign, exp: z.exp, frac: z.frac.lc]]; }; CFExtended: PUBLIC PROC [zz: REF Real.Extended, z: POINTER TO IeeeInternal.Ext] = TRUSTED { z.frac.lc _ zz.frac; z.exp _ zz.exp; z.det.sign _ zz.sign; z.det.type _ zz.type; z.det.sticky _ TRUE; }; InitIeee: PUBLIC PROC = TRUSTED { IF Real.Microcode THEN [] _ IeeeInternal.MicroSticky[0]; -- disable uCode IR trap }; END. L. Stewart July 5, 1980 3:29 PM Bug fix in rounding L. Stewart July 6, 1980 12:30 PM Bug fix in Denormalize, added InitIeee L. Stewart July 6, 1980 4:20 PM added microsticky L. Stewart July 8, 1980 5:00 PM RealOps August 25, 1980 10:25 AM, L. Stewart; fix to Denormalize, formatting August 25, 1980 5:09 PM, L. Stewart; smaller and slower 4-Feb-81 18:51:47, L. Stewart, NonTrappingNaN -> TrapNonTrappingNaNL June 3, 1982 11:39 am, L. Stewart, REF Extended August 27, 1982 1:00 pm, L. Stewart, CEDAR & TRUSTED January 14, 1984 4:56 pm, L. Stewart, change to IeeeInternal ŒIeeeUtil.mesa Last Modified: Stewart, August 27, 1982 11:33 am Last Modified: Paul Rovner, May 4, 1983 9:57 am IEEE float utilities Last Edited by: Levin, August 8, 1983 4:35 pm global variables Separate the packed REAL into its component elements denormalized or zero infinity or nan Stuff the components back into the packed REAL. Possible typo in standard here!!! IF fpmode.round=rm OR fpmode.round=rp THEN { IF NOT fpmode.traps[overflow] THEN thisTimeExceptions[overflow] _ FALSE; IF NOT fpmode.traps[underflow] THEN thisTimeExceptions[underflow] _ FALSE; }; clear hidden bit A 32 bit extended is considered to have its hidden bit as bit 0, significand as the next 29 bits, then G, then R, then S as a separate boolean. GRS computs the 3 bit number formed by the concatenation of G, R, and IF S THEN 1 ELSE 0. StickyBits are the set used for rounding to 24 bits Should flush these constants better overflow detect! Post Normalize. S does not participate positive count is left shift, negative is right shift DeNormalize is much like LongShift, except that it maintains the sticky bits on the right. And it only shifts right. This will get the globals. Ê }˜Jšœ ™ Jšœ0™0Jšœ/™/Jšœ™Jšœ-™-J˜šÏk ˜ Jšœœ˜$J˜ J˜ J˜J˜Jšœœ˜J˜—š œ œœœ+œ˜`Jšœœ˜J˜Jšœ™Jšœœ ˜.Jšœœ)˜CJšœ œ)˜J˜—Jšœ˜J˜—Jšœ˜J˜J˜—š ž œœœ œœœ˜:šœ ˜Jš œœœ œœ˜E˜ Jšœœ œœ˜E—J˜Jšœ5˜<—Jšœ™Jšœ œ"˜HJš œœœ œœ˜'Jšœœ&˜DJšœ œ˜>Jšœ œ!œ˜SJšœœ œ˜"J˜J˜—š žœœœœœœ˜<šœœ˜'J˜'J˜J˜ šœœ˜'J˜B—J˜—šœœ˜&Jšœœ˜"šœ˜Jšœ œ ˜Jš œœœ œœ ˜,Jšœœ œœ ˜(Jšœœ˜—Jšœ+œ!˜RJ˜Jšœ$˜)J˜—J˜J˜—š žœœœœœœ˜2Jšœœœ˜Jšœê™êšœœœœœœœ˜Jšœœ ˜Jšœ˜ JšœŸ*˜-—Jšœœœ˜#Jšœ œœ˜J˜J˜šœ˜˜šœ œ œ,˜FJšœœ˜——Jšœœ˜ Jšœœ œœ˜$Jš œœœ œœ˜(Jšœœ˜—š˜˜ J˜J˜,šœœ˜Jšœ™J˜"J˜J˜—J˜——J˜J˜J˜—šž œœœœ œœœ œœ˜TJ˜J˜ J˜Jšœœ˜:Jšœ˜J˜J˜—š ž œœœœœœ˜EJš œœ œœ œ˜EJ˜—šžœœœœ œœœ œœ˜PJš œœœœœ˜/J˜—šžœœœœ œœœ œœ˜PJš œœœœœ˜/J˜—š žœœœœœœ˜4Jšœœœ˜#šœœ˜šœœœ˜AJ˜—J˜—Jšœœœ ˜3šœœœ˜IJšœœ œ˜>—Jšœœœ˜1J˜J˜—šžœœœ˜,Jšœ*œ˜:J˜"Jšœœ˜ J˜.J˜0J˜/J˜/J˜KJ˜/Jšœ ˜J˜J˜—Jšœ'™'J˜š ž œœœœœœ˜:Jšœœœ˜šœœ0˜;Jšœ2œ˜:—J˜J˜—Jšœ5™5J˜š ž œœœœ œ œ˜