
DIRECTORY
Basics,
ConstArith;

ConstArithImpl: PROGRAM
IMPORTS Basics
EXPORTS ConstArith
= BEGIN OPEN ConstArith;

divisionMethod: DivisionMethod м princOps;
DivisionMethod: TYPE = {princOps, absMod, floor};

Overflow: PUBLIC ERROR = CODE;

DivByZero: PUBLIC ERROR = CODE;

one: Const = [sign: positive, low: 1, high: 0];

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];
};

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 {
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 {
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
highSum м highSum + 1;
IF highSum < x.high OR highSum < y.high THEN
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]] = {
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;
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;
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};
SELECT divisionMethod FROM
princOps => {};
absMod => IF r.sign = negative THEN {
r м Add[r, [sign: positive, low: y.low, high: y.high] ];
q м Add[q, [sign: sign, low: 1, high: 0] ];
};
floor =>
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];
};


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];
};


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
highSum м highSum + 1;
IF highSum < c1.high OR highSum < c2.high THEN
ERROR Overflow;
RETURN [ [c1.sign, lowSum, highSum] ];
};

END.


   ш  
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
Const: TYPE = RECORD [
sign: ConstSign,
low: CARD,
high: CARD];

ConstSign: TYPE = {negative, zero, positive};

Options

Governs behavior of DivMod (& Div & Mod)
[q, r] = DivMod[x, y] AND y # 0
=> x = q*y+r AND ABS[r] < ABS[y]
princOps =>
ABS[DivMod[x, y].q] = DivMod[ABS[x], ABS[y]].q
absMod =>
r < ABS[y]
floor =>
q = least z such that x = z*y+r AND ABS[r] < ABS[y]
(r # 0 => SIGN[r] = SIGN[y])
Exceptions

Constants

Conversions

Arithmetic

Have to take difference
Take the sum
A carry occurred
A carry occurred occurred, but we have no place to put it
In all non-overflow cases where y # 0:
q * y + r = x AND ABS[r] < ABS[y]
SELECT divisionMethod FROM
princOps => ABS[q] = DivMod[ABS[x], ABS[y]].q
absMod => r < ABS[y]
floor => SIGN[r] = SIGN[y]
First scale up u2 until we would be about to exceed the bounds.
At this point we start subtracting and shifting right.
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]).
If we insist that 0 < X MOD Y < ABS[Y], then we need one more adjustment.
(note: y < 0, sign is opposite of x.sign)
q is the least integer that satisfies
q*y + r = x AND ABS[r] < ABS[y]
which is equivalent to SIGN[r] = SIGN[y] OR SIGN[r] = 0
Comparison
Utilities
A carry occurred
A carry occurred occurred, but we have no place to put it
Э╩и  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ
╧eЬCЩNKЩ/KЩ(ЧKШ Ъ╧k	Ш	KЪЬШKЪЬШKШ ЧЪ╧nЬЮШKЪЮЬШKЪЮЬШKЪЬЮЬЮЬШЧKШ ЪЬЮЬЮЬЩKЩKЪЬЮЬЩ
KЪЬЮЬЩKЩ ЧЪЬЮЬЩ-KЩ ЧЩKЩ ЪЬ*Ш*KЪЬЮЬШ1Щ(ЪЬЩKЪЬ╧mЬЩ ЪЬЩKЪЬ.Щ.ЧЪЬ	Щ	KЪЬаЬЩ
ЧЪЬЩЪЬ+аЬЩ3KЩЧЧЧЧЧKШ ЧЩ
KЩ ЪЯЬЮЬЮЬШKШ ЧKЪЯ	ЬЮЬЮЬШKШ ЧЩ	KЩ KЪЬ/Ш/KШ ЧЩKЩ Ъ
ЯЬЮЬЮЬЮЬЮЬШ6KЪЬЮЬ
ЮЬЮЬШKKЪЮЬШKШЧЪ
ЯЬЮЬЮЬЮЬЮЬШ3KЪЬ-Ш-ЪЮЬЮШKЪЬЮЬЮЬЮЬШ;KЪЬ)Ш)KЪЬШKЪЮЬШЧKЪЮЬШKШЧЪЯЬЮЬЮЬЮЬШ5KЪЮЬЮЬЮЬЮЬ
Ш?KЪЮЬШKШЧЪЯЬЮЬЮЬЮЬШ3KЪЬЮЬШKЪЮЬЮЬЮЬ
Ш&ЪЮЬЮШШKЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ2KЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ=KЪЮЬ
ШKШЧШKЪЮЬЮЬЮЬЮЬЮЬЮЬШ,KЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ=KЪЮЬ
ШKШЧKЪЮЬЮЬШЧKШЧЧKШ Щ
KЩ ЪЯЬЮЬЮЬШ1KЪЮЬЮЬЮЬШ!KЪЮЬЮЬЮЬШ!ЪЮЬШЪЮЬШKЪЬЩЪЮЬЮШ$Ш	KЪЬ
ЮЬ╧c!ШCKЪЬ	ЮЬб!Ш@KЪЮЬЮЬШ.KЪ
ЮЬЮЬЮЬЮЬЮЬ
Ш4KЪЮЬ!Ш'KШЧШKЪЬ
ЮЬб!ШCKЪЬ	ЮЬб!Ш@KЪЮЬЮЬШ.KЪ
ЮЬЮЬЮЬЮЬЮЬ
Ш4KЪЮЬ!Ш'KШЧKЪЮЬЮЬЮЬ
ШЧKЪЮЬЮЬШ*KШЧЪЮЬШKЪЬЩKЪЬЮЬб!Ш?KЪЬ	ЮЬб!ШBЪЮЬЮЬЮШ(KЪЬЩKЪЬШЧЪЮЬЮЬЮШ,KЪЬ9Щ9KЪЮЬ
ШЧKЪЮЬШ%KШЧЧKШKШ ЧЪЯЬЮЬЮЬШ1ЪЮЬЮШKШKШKЪЮЬЮЬШЧKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬШ1KШKЪЬШKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬШ1KШKЪЬШKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬ!ШIЩ&KЪЬаЬЩ!ЧЪЬЩKЪЬ-Щ-KЪЬаЬЩKЪЬЩЧKЪЬЮЬЮЬ
ЮЬ
ШAЪЮЬЮЬЮШKЪЬЮЬШ!KЪЬЮЬШЪЮЬШ
ЪЮЬЮШ$KЪЬШШKЪЬШKЪЬШKШKЪЬЮЬШKШKЩ?ЪЮЬЮШKЪЬШЪЮЬЮШ(KЪЬЮЬШKЪЬЮЬЮЬШ(KЪЮЬШЧKЪЬШKЪЬШKЪЬ
Ш
KЪЮЬШЧKЪЬ6Щ6ЪЮШЪЮЬЮШ&ЪЬШKЪЬШKШKЪЮЬЮЬЮЬЮЬШ(KШЧKЪЬ!ЮЬЮЬШ.KЪЮЬШЧKЪЬШKЪЮЬЮЬЮЬШ>KЪЬШKЪЮЬШЧKЪЮЬЮЬЮЬШ.ЪЮШKЪЬШЧKШЧKЪЮЬЮЬШ&ЧЧЧЪЬЩKЪЬЮЬЩKЪ	ЬЮЬЮЬЮЬЮЬЩ*KЪ	ЬЮЬЮЬЮЬЮЬЩ"ЧЪЮЬЮШKЪЬШЪЬ
ЮЬЮЬШ%ЪЬаЬЮЬЮЬ&ЩIKЩ)ЧKШ8KЪЬ+Ш+KШЧЪЬШЩ%KЪ	ЬЮЬЮЬаЬЮЬЩЧKЪ	ЬЮЬЮЬЮЬЮЬЩ7ЪЮЬЮШKШKЪЮЬ%Ш,ЧЧKЪЮЬЮЬШЧKШKШ ЧЪЯЬЮЬЮЬШ1ЪЮЬЮЬЮШЪЬШKЪЮЬШЧЪЮЬШKЪЬ,Ш,KЪЬ/Ш/KЪЬ/Ш/KЪЬ:Ш:KЪЮЬЮЬЮЬ
Ш"KЪЮЬЮЬЮЬЮЬШ2KЪЮЬЮЬЮЬЮЬШ?KЪЬШKЪЮЬЮЬШ/KЪЮЬ
ШKШЧЧKШKШ ЧЪЯЬЮЬЮЬШ/ЪЮЬЮШKШKЪЮЬШЧKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬЮЬШ/ЪЮЬЮШKШKШKЪЮЬШЧKЪЮЬШKШKШ ЧЧЩ
KШ ЪЯЬЮЬЮЬШCЪЮЬ	ЮШЪЬЮЬ	ЮШKЪЬЮЬШ0KЪЬЮЬШ0KЪЮЬЮЬ	ШЧKЪЬЮЬШKЪЬЮЬШKЪЮЬЮЬЮЬЮЬЮЬЮЬШJЧKШKШ ЧЧЩ	KШ KЪЬЮЬ
Ю	ЬШ,KШ ЪЯЬЮЬЮЬЮЬШ2KЪЬЮЬШKЪЬЮЬШKЪЮЬЮЬШKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬЮЬШ1KЪЬЮЬ
Ю	ЬШ&KЪЬЮЬ
Ю	ЬШ'KЪЮЬЮЬШ-KЪЮЬШKШKШ ЧЪЯЬЮЬЮЬШGKЪЬ@Ш@KЪЮЬЮЬЮЬ	Ш%KЪЮЬ&Ш,KШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШ;KЪЮЬЮЬЮЬЮЬШ%KШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШ7KЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKЪЮЬ	ЮЬ	ЮЬШ!KЪЮЬ	ЮЬ	ЮЬШ%KЪЮЬЮЬШ"KШKШ ЧЪЯЬЮЬ
ЮЬЮЬШ6KЪЬ#ЮЬ,ШSKЪЬ$ЮЬ-ШUKЪЬ$ЮЬ-ШUKЪЬ$ЮЬ.ШVKЪЬJШJKЪЬШKЪЮЬRШXKШKШ ЧЪЯ	ЬЮЬЮЬЮЬШ:KЪЬЮЬб!ШAKЪЬ	ЮЬб!ШDЪЮЬЮЬЮШ*KЪЬЩKЪЬШЧЪЮЬЮЬЮШ.KЪЬ9Щ9KЪЮЬ
ШЧKЪЮЬ Ш&KШЧKШ ЧKЪЮЬШKШ KШ Ч ЕЧ    ╞  /V  