DIRECTORY Basics USING [BITAND, BITOR, DoubleShift, DoubleShiftRight, LongNumber], Ieee USING [BitOn, CVExtended, DeNormalize, Ext, funny, HiBit, MagicLI, NormalType, NotHiBit, Pack, PostNormalize, Round, RShift, SetFixOverflow, SetInvalidOperation, SetOverflow, StepTwo, TNnn, TNnz, TNzn, TNzz, Unpack], PrincOps USING [zDCOMP], Real USING [RealError, TrappingNaN], RealExceptions USING [ClearExceptions, RaiseException], RealOps USING [DefMode, Mode, RoundingMode, SetMode]; IeeeFloatB: PROGRAM IMPORTS Basics, Ieee, Real, RealExceptions, RealOps EXPORTS Ieee, RealOps = BEGIN OPEN Ieee, Real, RealOps; FComp: PUBLIC SAFE PROC [a, b: REAL, m: Mode] RETURNS [sense: INTEGER] = TRUSTED { inner: PROC = { x: Ext _ Ieee.Unpack[a]; y: Ext _ Ieee.Unpack[b]; { SELECT TRUE FROM Basics.BITAND[funny, Basics.BITOR[LOOPHOLE[x.det], LOOPHOLE[y.det]]] = 0 => SELECT Ieee.NormalType[x.det, y.det] FROM TNnn => NULL; TNnz => GOTO XSign; TNzn => GOTO YSign; TNzz => GOTO Equal; ENDCASE => ERROR; x.det.type = nan => GOTO InvX; y.det.type = nan => GOTO InvY; x.det.type = infinity AND y.det.type = infinity => IF m.im = projective OR x.det.sign = y.det.sign THEN GOTO Equal ELSE GOTO XSign; m.im = projective => GOTO InvX; x.det.type = infinity => GOTO XSign; y.det.type = infinity => GOTO YSign; ENDCASE => ERROR; SELECT TRUE FROM x.det.sign => { IF y.det.sign THEN { sense _ zFComp[ABS[b], ABS[a]]; RETURN; }; sense _ -1; }; y.det.sign => sense _ 1; ENDCASE => sense _ zFComp[a, b]; EXITS XSign => sense _ IF x.det.sign THEN -1 ELSE 1; YSign => sense _ IF y.det.sign THEN 1 ELSE -1; Equal => sense _ 0; InvX => InvalidAndDie[@x]; InvY => InvalidAndDie[@y]; }; }; DoWithMode[inner, m]; }; zFComp: PROC [a, b: REAL] RETURNS [INTEGER] = MACHINE CODE {PrincOps.zDCOMP; }; Float: PUBLIC SAFE PROC [a: INT, m: RealOps.Mode] RETURNS [r: REAL _ 0.0] = TRUSTED { inner: PROC = { x: Ieee.Ext; IF a < 0 THEN {x.det.sign _ TRUE; x.frac.li _ -a} ELSE {x.det.sign _ FALSE; x.frac.li _ a}; x.det.sticky _ FALSE; x.det.type _ normal; x.exp _ 31; Ieee.PostNormalize[@x]; Ieee.Round[@x]; r _ Ieee.Pack[@x]; }; IF a # 0 THEN DoWithMode[inner, m]; }; RoundLI: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [fli: INT] = TRUSTED { inner: PROC = { x: Ieee.Ext _ Ieee.Unpack[a]; inv, ov: BOOL; [v: fli, invalid: inv, overflow: ov] _ FixExtended[x, m.round]; IF inv THEN InvalidAndDie[@x]; IF ov THEN { Ieee.SetFixOverflow[]; IF m.traps[fixOverflow] THEN { clientFixup: BOOL; fraction: Basics.LongNumber; [clientFixup, fraction] _ RealExceptions.RaiseException[Ieee.CVExtended[x]]; IF clientFixup THEN fli _ fraction.li; }; }; }; DoWithMode[inner, m]; }; FixExtended: PUBLIC SAFE PROC [z: Ieee.Ext, rmode: RealOps.RoundingMode] RETURNS [v: INT, invalid, overflow: BOOLEAN] = TRUSTED { grs: INTEGER; { SELECT z.det.type FROM nan => GOTO Invalid; infinity => GOTO Invalid; zero => GOTO Zero; normal => NULL; ENDCASE => ERROR; IF z.exp > 30 THEN GOTO Overflow; { IF z.exp = 30 THEN { grs _ IF Ieee.BitOn[z.frac.lowbits, 1] THEN 4 ELSE 0; z.frac _ Ieee.RShift[z.frac]; } ELSE { Ieee.DeNormalize[@z, z.exp - 29]; grs _ Basics.BITAND[z.frac.lowbits, 3B]; grs _ grs + grs; z.frac _ Basics.DoubleShiftRight[z.frac, 2]; }; IF z.det.sticky THEN grs _ grs + 1; SELECT rmode FROM rn => IF grs > 4 OR (grs = 4 AND Ieee.BitOn[z.frac.lowbits, 1]) 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 => { z.frac.lc _ z.frac.lc + 1; IF Ieee.BitOn[z.frac.highbits, HiBit] THEN GOTO Overflow; }; }; EXITS Overflow => { IF z.det.sign AND z.frac.li = MagicLI THEN RETURN[v: MagicLI, invalid: FALSE, overflow: FALSE]; z.frac _ Basics.DoubleShift[z.frac, z.exp - 30]; z.frac.highbits _ Basics.BITAND[NotHiBit, z.frac.highbits]; RETURN[v: z.frac.li, invalid: FALSE, overflow: TRUE]; }; Invalid => RETURN[v: z.frac.li, invalid: TRUE, overflow: FALSE]; Zero => RETURN[v: 0, invalid: FALSE, overflow: FALSE]; }; IF z.det.sign THEN z.frac.li _ -z.frac.li; RETURN[v: z.frac.li, invalid: FALSE, overflow: FALSE]; }; InvalidAndDie: PROC [z: POINTER TO Ieee.Ext] = { Ieee.SetInvalidOperation[]; [] _ RealExceptions.RaiseException[Ieee.CVExtended[z^]]; ERROR Real.RealError; }; RoundI: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [fi: INTEGER] = TRUSTED { inner: PROC = { x: Ieee.Ext _ Ieee.Unpack[a]; fli: INT; inv, ov: BOOL; [v: fli, invalid: inv, overflow: ov] _ FixExtended[x, m.round]; IF inv THEN InvalidAndDie[@x]; IF ov OR fli NOT IN [FIRST[INTEGER]..LAST[INTEGER]] THEN { Ieee.SetFixOverflow[]; IF m.traps[fixOverflow] THEN { clientFixup: BOOL; fraction: Basics.LongNumber; [clientFixup, fraction] _ RealExceptions.RaiseException[Ieee.CVExtended[x]]; IF clientFixup THEN {fli _ fraction.li; GO TO done}; }; }; fi _ LOOPHOLE[LOOPHOLE[fli, Basics.LongNumber].lowbits, INTEGER]; EXITS done => {}; }; DoWithMode[inner, m]; }; RoundC: PUBLIC SAFE PROC [a: REAL, m: RealOps.Mode] RETURNS [fc: CARDINAL] = TRUSTED { inner: PROC = { x: Ieee.Ext _ Ieee.Unpack[a]; fli: INT; inv, ov: BOOL; [v: fli, invalid: inv, overflow: ov] _ FixExtended[x, m.round]; IF inv THEN InvalidAndDie[@x]; IF ov OR fli NOT IN [FIRST[CARDINAL]..LAST[CARDINAL]] THEN { Ieee.SetFixOverflow[]; IF m.traps[fixOverflow] THEN { clientFixup: BOOL; fraction: Basics.LongNumber; [clientFixup, fraction] _ RealExceptions.RaiseException[Ieee.CVExtended[x]]; IF clientFixup THEN {fc _ fraction.lowbits; GO TO done}; }; IF NOT ov AND x.det.sign THEN fli _ -fli; }; fc _ LOOPHOLE[fli, Basics.LongNumber].lowbits; EXITS done => {}; }; DoWithMode[inner, m]; }; FScale: PUBLIC SAFE PROC [a: REAL, scale: INTEGER, m: Mode _ DefMode] RETURNS [r: REAL] = TRUSTED { inner: PROC = { x: Ieee.Ext _ Ieee.Unpack[a]; SELECT x.det.type FROM normal => { IF scale > 400 THEN Ieee.SetOverflow[@x]; IF scale < -400 THEN Ieee.SetOverflow[@x]; x.exp _ x.exp + scale; Ieee.StepTwo[@x]; }; nan => IF a # Real.TrappingNaN THEN RETURN; ENDCASE => RETURN; r _ Ieee.Pack[@x]; }; r _ a; DoWithMode[inner, m]; }; DoWithMode: PROC [inner: PROC, mode: Mode] = { old: Mode _ RealOps.SetMode[mode]; RealExceptions.ClearExceptions[]; inner[ ! UNWIND => [] _ RealOps.SetMode[old]]; [] _ RealOps.SetMode[old]; }; END. L. Stewart, July 12, 1980 11:13 PM, Rounds changed to return low order bits on RESUME. L. Stewart, August 12, 1980 12:05 PM, RoundI, RoundC fixed for negative arguments. August 25, 1980 4:05 PM, LStewart; formatting, shorten Float June 3, 1982 12:02 pm, L. Stewart, REF Extended in RealException, SqRt and FScale August 27, 1982 11:30 am, L. Stewart, added TRUSTED January 14, 1984 4:51 pm, L. Stewart, change to Ieee LIeeeFloatB.mesa - Mesa implementation of floating point ops Copyright c 1985 by Xerox Corporation. All rights reserved. Rovner On May 4, 1983 9:55 am Levin, August 8, 1983 4:32 pm Russ Atkinson (RRA) June 5, 1985 7:33:41 pm PDT Normal case: Neither operand is infinity or NaN Signs are equal and both negative, so sense of the comparison of the absolute values is reversed At this point, x is negative and y is positive x is positive and y is negative, the return is obvious Both are positive, so integer comparison is (surprisingly) valid returns positive without looking at sign ‌ت §کcodeڑœ;™;Kڑœ دmœ1™