<<>> <> <> <> <> DIRECTORY Basics, ConstArith; ConstArithImpl: PROGRAM IMPORTS Basics EXPORTS ConstArith = BEGIN OPEN ConstArith; <> <> <> <> <<>> <> <<>> <> <<>> divisionMethod: DivisionMethod ¬ princOps; DivisionMethod: TYPE = {princOps, absMod, floor}; <> <<[q, r] = DivMod[x, y] AND y # 0>> <<=> x = q*y+r AND ABS[r] >> <>> <> <>> <> <>> <> <<(r # 0 => SIGN[r] = SIGN[y])>> <> <<>> 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]] = { <> <> <> < ABS[q] = DivMod[ABS[x], ABS[y]].q>> < r >> < 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; <> 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 { <> <<(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 => <> <> <> 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.