ConstArithImpl.mesa
Copyright Ó 1986, 1988, 1989, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) May 10, 1989 1:57:42 am PDT
Willie-s, September 24, 1991 4:44 pm PDT
DIRECTORY
Basics,
ConstArith;
ConstArithImpl: PROGRAM
IMPORTS Basics
EXPORTS ConstArith
= BEGIN OPEN ConstArith;
Const: TYPE = RECORD [
sign: ConstSign,
low: CARD,
high: CARD];
ConstSign: TYPE = {negative, zero, positive};
Options
divisionMethod: DivisionMethod ¬ princOps;
DivisionMethod: TYPE = {princOps, absMod, floor};
Governs behavior of DivMod (& Div & Mod)
[q, r] = DivMod[x, y] AND y # 0
=> x = q*y+r AND ABS[r] d ABS[y]
princOps =>
ABS[DivMod[x, y].q] = DivMod[ABS[x], ABS[y]].q
absMod =>
r d ABS[y]
floor =>
q = least z such that x = z*y+r AND ABS[r] d ABS[y]
(r # 0 => SIGN[r] = SIGN[y])
Exceptions
Overflow: PUBLIC ERROR = CODE;
DivByZero: PUBLIC ERROR = CODE;
Constants
one: Const = [sign: positive, low: 1, high: 0];
Conversions
FromCard: PUBLIC PROC [card: CARD] RETURNS [Const] = {
c: Const ¬ [sign: IF card = 0 THEN zero ELSE positive, low: card, high: 0];
RETURN [c];
};
FromInt: PUBLIC PROC [int: INT] RETURNS [Const] = {
c: Const ¬ [sign: positive, low: 0, high: 0];
SELECT int FROM
= FIRST[INT] => {c.low ¬ LOOPHOLE[int]; c.sign ¬ negative};
< 0 => {c.low ¬ -int; c.sign ¬ negative};
= 0 => c.sign ¬ zero;
ENDCASE => c.low ¬ int;
RETURN [c];
};
ToCard: PUBLIC PROC [const: Const] RETURNS [CARD] = {
IF const.sign = negative OR const.high # 0 THEN ERROR Overflow;
RETURN [const.low];
};
ToInt: PUBLIC PROC [const: Const] RETURNS [INT] = {
low: CARD ¬ const.low;
IF const.high # 0 THEN ERROR Overflow;
SELECT const.sign FROM
negative => {
IF low <= CARD[LAST[INT]] THEN RETURN [-INT[low]];
IF low = LOOPHOLE[FIRST[INT], CARD] THEN RETURN [FIRST[INT]];
ERROR Overflow;
};
positive => {
IF low <= CARD[LAST[INT]] THEN RETURN [low];
IF low = LOOPHOLE[FIRST[INT], CARD] THEN RETURN [FIRST[INT]];
ERROR Overflow;
};
ENDCASE => RETURN [0];
};
Arithmetic
Add: PUBLIC PROC [x,y: Const] RETURNS [Const] = {
IF x.sign = zero THEN RETURN [y];
IF y.sign = zero THEN RETURN [x];
IF x.sign # y.sign
THEN {
Have to take difference
SELECT UnsignedComparison[x, y] FROM
less => {
highDiff: CARD ¬ y.high - x.high; -- requires no overflow checking!
lowDiff: CARD ¬ y.low - x.low; -- requires no overflow checking!
IF x.low > y.low THEN highDiff ¬ highDiff - 1;
IF lowDiff = 0 AND highDiff = 0 THEN GO TO zeroExit;
RETURN [ [y.sign, lowDiff, highDiff] ];
};
greater => {
highDiff: CARD ¬ x.high - y.high; -- requires no overflow checking!
lowDiff: CARD ¬ x.low - y.low; -- requires no overflow checking!
IF y.low > x.low THEN highDiff ¬ highDiff - 1;
IF lowDiff = 0 AND highDiff = 0 THEN GO TO zeroExit;
RETURN [ [x.sign, lowDiff, highDiff] ];
};
ENDCASE => GO TO zeroExit;
EXITS zeroExit => RETURN [ [zero, 0, 0] ];
}
ELSE {
Take the sum
lowSum: CARD ¬ x.low + y.low; -- requires no overflow checking!
highSum: CARD ¬ x.high + y.high; -- requires no overflow checking!
IF lowSum < x.low OR lowSum < y.low THEN
A carry occurred
highSum ¬ highSum + 1;
IF highSum < x.high OR highSum < y.high THEN
A carry occurred occurred, but we have no place to put it
ERROR Overflow;
RETURN [ [x.sign, lowSum, highSum] ];
};
};
Sub: PUBLIC PROC [x,y: Const] RETURNS [Const] = {
SELECT y.sign FROM
negative => y.sign ¬ positive;
positive => y.sign ¬ negative;
ENDCASE => RETURN [x];
RETURN [Add[x, y]];
};
Div: PUBLIC PROC [x,y: Const] RETURNS [Const] = {
q,r: Const;
[q, r] ¬ DivMod[x, y];
RETURN [q];
};
Mod: PUBLIC PROC [x,y: Const] RETURNS [Const] = {
q,r: Const;
[q, r] ¬ DivMod[x, y];
RETURN [r];
};
DivMod: PUBLIC PROC [x,y: Const] RETURNS [q, r: Const ¬ [zero, 0, 0]] = {
In all non-overflow cases where y # 0:
q * y + r = x AND ABS[r] d ABS[y]
SELECT divisionMethod FROM
princOps => ABS[q] = DivMod[ABS[x], ABS[y]].q
absMod => r d ABS[y]
floor => SIGN[r] = SIGN[y]
sign: ConstSign ¬ IF x.sign = y.sign THEN positive ELSE negative;
SELECT TRUE FROM
y.sign = zero => ERROR DivByZero;
x.sign = zero => RETURN;
ENDCASE =>
SELECT UnsignedComparison[x, y] FROM
less => r ¬ x;
greater => {
u1: Const ¬ x;
u2: Const ¬ y;
bit: Const ¬ [positive, 1, 0];
bits: NAT ¬ 1;
u1.sign ¬ u2.sign ¬ positive;
First scale up u2 until we would be about to exceed the bounds.
WHILE u2.high < highCardBit DO
next: Const ¬ Double[u2];
SELECT UnsignedComparison[u1, next] FROM
less => EXIT;
equal => {q ¬ Double[bit]; GO TO exact};
ENDCASE;
bit ¬ Double[bit];
bits ¬ bits + 1;
u2 ¬ next;
ENDLOOP;
At this point we start subtracting and shifting right.
DO
SELECT UnsignedComparison[u1, u2] FROM
greater => {
q ¬ DoubleAdd[q, bit];
u1 ¬ Sub[u1, u2];
IF u1.high = 0 AND u1.low = 0 THEN EXIT;
};
equal => {q ¬ DoubleAdd[q, bit]; GO TO exact};
ENDCASE;
u2 ¬ Halve[u2];
IF (bits ¬ bits - 1) = 0 THEN {r ¬ u1; r.sign ¬ x.sign; EXIT};
bit ¬ Halve[bit];
ENDLOOP;
IF q.high # 0 OR q.low # 0 THEN q.sign ¬ sign;
EXITS
exact => q.sign ¬ sign;
};
ENDCASE => {q ¬ [sign, 1, 0]; RETURN};
At this point:
X # 0 AND Y # 0
q = SIGN[X] * SIGN[Y] * (ABS[X] / ABS[Y]);
r = SIGN[X] * (ABS[X] MOD ABS[y]).
SELECT divisionMethod FROM
princOps => {};
absMod => IF r.sign = negative THEN {
If we insist that 0 d X MOD Y < ABS[Y], then we need one more adjustment.
(note: y < 0, sign is opposite of x.sign)
r ¬ Add[r, [sign: positive, low: y.low, high: y.high] ];
q ¬ Add[q, [sign: sign, low: 1, high: 0] ];
};
floor =>
q is the least integer that satisfies
q*y + r = x AND ABS[r] d ABS[y]
which is equivalent to SIGN[r] = SIGN[y] OR SIGN[r] = 0
SELECT r.sign FROM
y.sign, zero => {};
ENDCASE => {r ¬ Add[r, y]; q ¬ Sub[q, one]};
ENDCASE => ERROR;
};
Mul: PUBLIC PROC [x,y: Const] RETURNS [Const] = {
SELECT TRUE FROM
x.sign = zero, y.sign = zero =>
RETURN [ [zero, 0, 0] ];
ENDCASE => {
loProd: Const ¬ DoubleProduct[x.low, y.low];
midProd1: Const ¬ DoubleProduct[x.low, y.high];
midProd2: Const ¬ DoubleProduct[x.high, y.low];
m: Const ¬ AddCD[loProd.high, midProd1.low, midProd2.low];
IF m.high # 0 THEN ERROR Overflow;
IF x.high # 0 AND y.high # 0 THEN ERROR Overflow;
IF midProd1.high # 0 OR midProd2.high # 0 THEN ERROR Overflow;
loProd.high ¬ m.low;
IF x.sign # y.sign THEN loProd.sign ¬ negative;
RETURN [loProd];
};
};
Abs: PUBLIC PROC [c: Const] RETURNS [Const] = {
SELECT c.sign FROM
negative => c.sign ¬ positive;
ENDCASE;
RETURN [c];
};
Neg: PUBLIC PROC [c: Const] RETURNS [Const] = {
SELECT c.sign FROM
negative => c.sign ¬ positive;
positive => c.sign ¬ negative;
ENDCASE;
RETURN [c];
};
Comparison
Compare: PUBLIC PROC [c1,c2: Const] RETURNS [Basics.Comparison] = {
SELECT c1.sign FROM
c2.sign => SELECT c1.sign FROM
positive => RETURN [UnsignedComparison[c1, c2]];
negative => RETURN [UnsignedComparison[c2, c1]];
ENDCASE => RETURN [equal];
negative => RETURN [less];
positive => RETURN [greater];
ENDCASE => IF c2.sign = negative THEN RETURN [greater] ELSE RETURN [less];
};
Utilities
highCardBit: CARD ¬ Basics.BITLSHIFT[1, 31];
Double: PROC [c: Const] RETURNS [Const] = INLINE {
s1: CARD ¬ c.low + c.low;
s2: CARD ¬ c.high + c.high;
IF s1 < c.low THEN s2 ¬ s2 + 1;
RETURN [ [c.sign, s1, s2] ];
};
Halve: PROC [c: Const] RETURNS [Const] = INLINE {
s1: CARD ¬ Basics.BITRSHIFT[c.low, 1];
s2: CARD ¬ Basics.BITRSHIFT[c.high, 1];
IF s2+s2 # c.high THEN s1 ¬ s1 + highCardBit;
RETURN [ [c.sign, s1, s2] ];
};
UnsignedComparison: PROC [c1,c2: Const] RETURNS [Basics.Comparison] = {
sense: Basics.Comparison ¬ Basics.CompareCard[c1.high, c2.high];
IF sense # equal THEN RETURN [sense];
RETURN [Basics.CompareCard[c1.low, c2.low]];
};
AddC: PROC [c1, c2, c3: CARDINAL] RETURNS [CARD] = INLINE {
RETURN [c1.LONG + c2.LONG + c3.LONG];
};
AddCD: PROC [x1,x2,x3: CARD] RETURNS [Const] = INLINE {
c: CARDINAL ¬ 0;
s1: CARD ¬ x1 + x2;
s2: CARD ¬ s1 + x3;
IF s1 < x1 OR s1 < x2 THEN c ¬ 1;
IF s2 < s1 OR s2 < x3 THEN c ¬ c + 1;
RETURN [ [positive, s2, c.LONG] ];
};
DoubleProduct: PROC [c1, c2: CARD] RETURNS [Const] = {
lowProd: Basics.LongNumber ¬ [card[CARD[Basics.LowHalf[c1]] * Basics.LowHalf[c2]]];
midProd1: Basics.LongNumber ¬ [card[CARD[Basics.LowHalf[c1]] * Basics.HighHalf[c2]]];
midProd2: Basics.LongNumber ¬ [card[CARD[Basics.HighHalf[c1]] * Basics.LowHalf[c2]]];
highProd: Basics.LongNumber ¬ [card[CARD[Basics.HighHalf[c1]] * Basics.HighHalf[c2]]];
m: Basics.LongNumber ¬ [card[AddC[lowProd.hi, midProd1.lo, midProd2.lo]]];
lowProd.hi ¬ m.lo;
RETURN [[positive, lowProd.card, highProd.card + AddC[m.hi, midProd1.hi, midProd2.hi]]];
};
DoubleAdd: PROC [c1, c2: Const] RETURNS [Const] = INLINE {
lowSum: CARD ¬ c1.low + c2.low; -- requires no overflow checking!
highSum: CARD ¬ c1.high + c2.high; -- requires no overflow checking!
IF lowSum < c1.low OR lowSum < c2.low THEN
A carry occurred
highSum ¬ highSum + 1;
IF highSum < c1.high OR highSum < c2.high THEN
A carry occurred occurred, but we have no place to put it
ERROR Overflow;
RETURN [ [c1.sign, lowSum, highSum] ];
};
END.