DIRECTORY Basics USING [LongMult], IPReal USING [Rational, ShortRational], Real USING [Fix, RealException], RealFns USING [AlmostEqual], RuntimeError USING [BoundsFault] ; IPRealImpl: CEDAR PROGRAM IMPORTS Basics, Real, RealFns, RuntimeError EXPORTS IPReal ~ BEGIN Fix: PRIVATE PROC[r: REAL] RETURNS[INT] ~ { RETURN[Real.Fix[r]] }; Floor: PUBLIC PROC[a: REAL] RETURNS[c: REAL] ~ { c _ Fix[a ! Real.RealException => { c _ a; CONTINUE }]; IF c>a THEN RETURN[c-1] ELSE RETURN[c] }; Ceiling: PUBLIC PROC[a: REAL] RETURNS[c: REAL] ~ { c _ Fix[a ! Real.RealException => { c _ a; CONTINUE }]; IF c { c _ a; CONTINUE }]; RETURN[c] }; Round: PUBLIC PROC[a: REAL] RETURNS[c: REAL] ~ { RETURN[Floor[a + 0.5]] }; Mod: PUBLIC PROC[a, b: REAL] RETURNS[REAL] ~ { RETURN[a - b*Floor[a/b]] }; Rem: PUBLIC PROC[a, b: REAL] RETURNS[REAL] ~ { RETURN[a - b*Trunc[a/b]] }; Inverse: PROC [real: REAL] RETURNS [REAL] ~ {RETURN [1.0/real]}; FloorN: PROC [real: REAL] RETURNS [NAT] ~ {RETURN [Real.Fix[real]]}; ShortRationalFromReal: PUBLIC PROC [real: REAL] RETURNS [ans: IPReal.ShortRational] ~ { abs: REAL ~ ABS[real]; p: NAT _ 1; q: CARDINAL _ 0; BEGIN ENABLE Real.RealException, RuntimeError.BoundsFault => GOTO Done; f: NAT _ FloorN[abs]; r: REAL _ abs-f; pp: NAT _ p; qq: CARDINAL _ q; p _ f; q _ 1; WHILE r # 0 DO rinv: REAL _ Inverse[r]; fnew: NAT _ FloorN[rinv]; pnew: LONG CARDINAL _ Basics.LongMult[fnew, p] + pp; qnew: LONG CARDINAL _ Basics.LongMult[fnew, q] + qq; IF pnew > NAT.LAST OR qnew > CARDINAL.LAST THEN EXIT; pp _ p; qq _ q; p _ pnew; q _ qnew; r _ rinv - fnew; ENDLOOP; EXITS Done => NULL; END; ans.numerator _ p; ans.denominator _ q; IF real < 0 THEN ans.numerator _ -ans.numerator; }; mantissaBits: INTEGER _ MantissaBits[]; MantissaBits: PROC RETURNS [n: INTEGER] ~ { f: REAL _ 0.5; n _ 0; WHILE 1.0 - f # 1.0 DO f _ f/2; n _ n + 1; ENDLOOP; }; bigInt: INT _ Real.Fix[REAL[LAST[INT]/256*256]]; -- Fix of largest real that can be fixed. RationalFromReal: PUBLIC PROC [real: REAL] RETURNS [ans: IPReal.Rational] ~ { abs: REAL ~ ABS[real]; p: REAL _ 1; q: REAL _ 0; BEGIN ENABLE Real.RealException, RuntimeError.BoundsFault => GOTO Done; f: REAL _ Trunc[abs]; r: REAL _ abs-f; pp: REAL _ p; qq: REAL _ q; p _ f; q _ 1; UNTIL RealFns.AlmostEqual[p, abs*q, 3-mantissaBits] DO rinv: REAL _ Inverse[r]; fnew: REAL _ Trunc[rinv]; pnew: REAL _ fnew*p + pp; qnew: REAL _ fnew*q + qq; IF pnew > bigInt OR qnew > bigInt THEN EXIT; pp _ p; qq _ q; p _ pnew; q _ qnew; r _ rinv - fnew; ENDLOOP; EXITS Done => NULL; END; ans.numerator _ Real.Fix[p]; ans.denominator _ Real.Fix[q]; IF real < 0 THEN ans.numerator _ -ans.numerator; }; END. ΒIPRealImpl.mesa Copyright c 1984, 1985 Xerox Corporation. All rights reserved. Doug Wyatt, May 20, 1985 2:08:58 pm PDT Michael Plass, October 9, 1985 12:05:25 pm PDT This procedure copes with a "feature" of Mesa's signal handling. Because Real.Fix actually compiles into machine code, any signal it raises cannot be caught in the statement that invokes it; the catch phrase must be at least one procedure call away. To fix a real number and catch any exception, say Fix[r ! Real.RealException => GOTO Fail]; This is a separate procedure to make sure that exceptions gets caught. This is a separate procedure to make sure that exceptions gets caught. Works correctly for non-negative arguments only. Κ‰˜codešœ™Kšœ Οmœ4™?Kšœ'™'K™.—K˜šΟk ˜ Kšœžœ ˜Kšœžœ˜'Kšœžœ˜ Kšœžœ˜Kšœ žœ˜ Kšœ˜—K˜KšΠbl œžœž˜Kšžœ$˜+Kšžœ˜Kšœž˜K˜šΟnœžœžœžœžœžœžœ˜BKšœΥ™ΥK˜—š  œžœžœžœžœžœ˜0Kšœ+žœ˜7Kš žœžœžœžœžœ˜&K˜K˜—š  œžœžœžœžœžœ˜2Kšœ+žœ˜7Kš žœžœžœžœžœ˜&K˜K˜—š  œžœžœžœžœžœ˜0Kšœ+žœ˜7Kšžœ˜ K˜K˜—š  œžœžœžœžœžœ˜0Kšžœ˜K˜K˜—š  œžœžœžœžœžœ˜.Kšžœ˜K˜K˜—š  œžœžœžœžœžœ˜.Kšžœ˜K˜K˜—J˜š  œžœžœžœžœžœ ˜@JšœF™FJ˜—š  œžœžœžœžœžœ˜DJšœF™FJ™0J˜—š  œžœžœžœžœ ˜WJšœžœžœ˜Jšœžœ˜ Jšœžœ˜šžœžœ1žœ˜GJšœžœ˜Jšœžœ ˜Jšœžœ˜ Jšœžœ˜J˜J˜šžœž˜Jšœžœ˜Jšœžœ˜Jšœžœžœ!˜4Jšœžœžœ!˜4Jšžœžœžœžœžœžœžœžœ˜5Jšœ˜J˜Jšœ ˜ Jšœ ˜ Jšœ˜Jšžœ˜—Jšžœ žœ˜Jšžœ˜—Jšœ˜Jšœ˜Jšžœ žœ ˜0Jšœ˜J˜—šœžœ˜'š  œžœžœžœ˜+Jšœžœ˜J˜šžœž˜J˜J˜ Jšžœ˜—Jšœ˜J˜——š œžœ žœžœžœ Οc)˜ZJ˜—š  œžœžœžœžœ˜MJšœžœžœ˜Jšœžœ˜ Jšœžœ˜ šžœžœ1žœ˜GJšœžœ˜Jšœžœ ˜Jšœžœ˜ Jšœžœ˜ J˜J˜šžœ/ž˜6Jšœžœ˜Jšœžœ˜Jšœžœ˜Jšœžœ˜Jšžœžœžœžœ˜,Jšœ˜J˜Jšœ ˜ Jšœ ˜ Jšœ˜Jšžœ˜—Jšžœ žœ˜Jšžœ˜—Jšœ˜Jšœ˜Jšžœ žœ ˜0Kšœ˜—J˜K˜Kšžœ˜—…— Μ