IPRealImpl.mesa
Copyright © 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
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]] };
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];
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<a
THEN
RETURN[c+1]
ELSE
RETURN[c]
};
Trunc:
PUBLIC
PROC[a:
REAL]
RETURNS[c:
REAL] ~ {
c ← Fix[a ! Real.RealException => { 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]};
This is a separate procedure to make sure that exceptions gets caught.
FloorN:
PROC [real:
REAL]
RETURNS [
NAT] ~ {
RETURN [Real.Fix[real]]};
This is a separate procedure to make sure that exceptions gets caught.
Works correctly for non-negative arguments only.
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.