--============================================================================= --| --| PACKAGE NAME: numbers --| --| NOTES: Operators generally assume multiple-precision parameters to be --| canonical--to be valid representations or to be "invalid," that is, to --| carry an invalid flag. Except for zero itself, canonical numbers have --| no leading 0 digits. Numbers returned are intended to be canonical --| also. Zero is always represented as positive. --| --============================================================================= PACKAGE BODY numbers IS -- Range of possible carries or borrows SUBTYPE carry_or_borrow IS radix_digit RANGE 0 .. 1; --========================================================================== --| --| FUNCTION NAME: numbers.make_number --| --| ALGORITHM/STRATEGY: Check parameter validity and set values of result. --| --| NOTES: None. --| --========================================================================== FUNCTION make_number (radix : IN radix_range; digit : IN integer) RETURN number IS -- Number to be returned result : number; BEGIN -- make_number -- Check if parameters valid IF (ABS(digit) < radix) THEN -- Set sign IF (digit < 0) THEN result.sign := minus; ELSE result.sign := plus; END IF; -- Set radix, length of number, and single digit result.radix := radix; result.high_order_digit := 1; result.digit(1) := ABS(digit); ELSE -- Flag number as invalid result.radix := invalid_number_flag; END IF; -- Return number generated RETURN result; END make_number; --========================================================================== --| --| FUNCTION NAME: numbers."-" (unary minus) --| --| ASSUMPTIONS/LIMITATIONS: Parameter a is assumed canonical. --| --| ALGORITHM/STRATEGY: Copy number and reverse sign unless parameter is 0. --| --| NOTES: None. --| --========================================================================== FUNCTION "-" (a : IN number) RETURN number IS -- Number to be returned result : number; BEGIN -- "-" -- Copy number result := a; IF (a.high_order_digit = 1) AND THEN (a.digit(1) = 0) THEN -- Set sign to positive for zero a result.sign := plus; ELSE -- Reverse sign for non-zero a IF (a.sign = plus) THEN result.sign := minus; ELSE result.sign := plus; END IF; END IF; -- Return number generated RETURN result; END "-"; --========================================================================== --| --| FUNCTION NAME: numbers."abs" --| --| ASSUMPTIONS/LIMITATIONS: Parameter a is assumed canonical. --| --| ALGORITHM/STRATEGY: Set sign of result to plus. --| --| NOTES: None. --| --========================================================================== FUNCTION "abs" (a : IN number) RETURN number IS -- Number to be returned result : number; BEGIN -- "abs" -- Make sign of result positive result := a; result.sign := plus; -- Return number generated RETURN result; END "abs"; --========================================================================== --| --| FUNCTION NAME: numbers."<=" --| --| ASSUMPTIONS/LIMITATIONS: Parameters are assumed canonical. --| --| ALGORITHM/STRATEGY: Determine signs of parameters; result is --| immediately determined if they differ. Otherwise, the result is --| determined from the number with the most number of digits. If --| signs and lengths are the same, procedure distinguish is used to --| determine the result. --| --| NOTES: None. --| --========================================================================== FUNCTION "<=" (a, b : IN number) RETURN Boolean IS --======================================================================= --| --| FUNCTION NAME: numbers."<=".distinguish --| --| PURPOSE: To determine if |x| <= |y|. --| --| PROGRAMMER: Lionel Deimel DATE WRITTEN: 5/21/90 --| DATE OF LAST REVISION: 8/9/90 VERSION: 1.2 --| --| PARAMETERS: --| x (in) number --| --| y (in) number --| --| INPUT/OUTPUT: None. --| --| ASSUMPTIONS/LIMITATIONS: The parameters are assumed to have the same --| radix and the same number of digits. --| --| ALGORITHM/STRATEGY: Corresponding digits of the parameters are --| compared from left to right until a difference between them is --| found or it is determined that there is no difference between them. --| --| ERROR CHECKS/RESPONSES: None. --| --| NOTES: The signs of the parameters are ignored. --| --======================================================================= FUNCTION distinguish (x, y : IN number) RETURN Boolean IS -- Difference found in corresponding digits distinguished : Boolean := false; -- Value of x found to be or assumed to be less than that of y x_less : Boolean := false; BEGIN -- distinguish -- Examine corresponding digits until a difference is found or -- all digits are examined FOR position IN REVERSE 1 .. x.high_order_digit LOOP IF (x.digit(position) > y.digit(position)) THEN -- Smaller digit found in y distinguished := true; x_less := false; ELSIF (x.digit(position) < y.digit(position)) THEN -- Smaller digit found in x distinguished := true; x_less := true; END IF; -- Terminate loop early if unequal corresponding digits found EXIT WHEN distinguished; END LOOP; -- Return true if smaller digit found in x or all digits -- are the same RETURN (x_less OR ELSE (NOT distinguished)); END distinguish; BEGIN -- "<=" IF (a.radix /= b.radix) OR ELSE (a.radix = invalid_number_flag) OR ELSE (b.radix = invalid_number_flag) THEN -- Comparison invalid RETURN false; ELSE IF (a.sign /= b.sign) THEN -- Signs differ; true if a negative RETURN (a.sign = minus); ELSE If (a.sign = plus) THEN --Both signs positive; true if a <= b IF (a.high_order_digit < b.high_order_digit) THEN RETURN true; ELSIF (b.high_order_digit < a.high_order_digit) THEN RETURN false; ELSE RETURN distinguish(a, b); END IF; ELSE --Both signs negative; true if |a| <= |b| IF (b.high_order_digit < a.high_order_digit) THEN RETURN true; ELSIF (a.high_order_digit < b.high_order_digit) THEN RETURN false; ELSE RETURN distinguish(b, a); END IF; END IF; END IF; END IF; END "<="; --========================================================================== --| --| FUNCTION NAME: numbers."=" --| --| ASSUMPTIONS/LIMITATIONS: Parameters are assumed canonical. --| --| ALGORITHM/STRATEGY: Check radices, sign, and corresponding slices --| of digit arrays for inequality. --| --| NOTES: None. --| --========================================================================== FUNCTION "=" (a, b : IN number) RETURN Boolean IS BEGIN -- "=" IF (a.radix /= b.radix) OR ELSE (a.radix = invalid_number_flag) OR ELSE (b.radix = invalid_number_flag) OR ELSE (a.sign /= b.sign) OR ELSE (a.high_order_digit /= b.high_order_digit) THEN -- Comparison is not valid, signs differ, or numbers are -- of different length RETURN false; ELSE IF (a.digit(1 .. a.high_order_digit) /= b.digit(1 .. b.high_order_digit)) THEN -- Signs and lengths are same, but digits differ RETURN false; ELSE -- Signs, lengths, and digits are the same RETURN true; END IF; END IF; END "="; --========================================================================== --| --| FUNCTION NAME: numbers.convert_to_string --| --| ASSUMPTIONS/LIMITATIONS: Parameter is assumed canonical. --| --| ALGORITHM/STRATEGY: Character string is generated from left to right. --| Attributes are used to generate and space characters. --| --| NOTES: None. --| --========================================================================== FUNCTION convert_to_string (a : IN number) RETURN dynamic_string IS -- String in which character representation of a is generated result : dynamic_string; -- Position in result.char up to which character array has been filled string_length : dynamic_string_index_range; BEGIN -- convert_to_string IF (a.radix = invalid_number_flag) THEN -- "Error" returned if number invalid result := invalid_number_string; ELSE -- Generate sign IF (a.sign = plus) THEN result.char(1) := '+'; ELSE result.char(1) := '-'; END IF; -- Generate digits from left to right string_length := 1; FOR position IN REVERSE 1 .. a.high_order_digit LOOP result.char(string_length+1 .. string_length+radix_digit'image(a.digit(position))'last) := radix_digit'image(a.digit(position)); string_length := string_length + radix_digit'image(a.digit(position))'last; END LOOP; -- Generate "Base" and radix result.char(string_length+1 .. string_length+5+ radix_range'image(a.radix)'last) := " Base" & radix_range'image(a.radix); result.length := string_length + 5 + radix_range'image(a.radix)'last; END IF; -- Return string generated RETURN result; END convert_to_string; --========================================================================== --| --| FUNCTION NAME: numbers."-" (binary minus) --| --| ASSUMPTIONS/LIMITATIONS: Parameters are assumed canonical. --| --| ALGORITHM/STRATEGY: If operands are valid, the signs are checked to see --| if they are the same. If they are, the difference is computed using --| numbers."+" and numbers."-" (unary minus). Otherwise, the operand --| of larger magnitude is found, and procedure perform_subtraction --| is used to find the digits of the difference. --| --| NOTES: None. --| --========================================================================== FUNCTION "-" (a, b : IN number) RETURN number IS -- Number where difference is computed result : number; --======================================================================= --| --| PROCEDURE NAME: numbers."-".perform_subtraction --| --| PURPOSE: To generate the digits of the difference of two --| multiple-precision integers. --| --| PROGRAMMER: Lionel Deimel DATE WRITTEN: 5/21/90 --| DATE OF LAST REVISION: 7/26/90 VERSION: 1.1 --| --| PARAMETERS: --| x (in) first operand --| --| y (in) second operand --| --| result (in out) on exit, contains digits and --| pointer to high-order-digit of --| difference; other fields are --| unchanged --| --| INPUT/OUTPUT: None. --| --| ASSUMPTIONS/LIMITATIONS: The operands are assumed to have --| legitimate values and to share the same radix. The magnitude --| of the first operand is assumed to be at least as large as that --| of the second. --| --| ALGORITHM/STRATEGY: If the digits of the operands are the same, --| zero is returned. Otherwise, subtraction is performed on the --| meaningful slice of the digit array of the second operand and --| the corresponding slice from the first operand, noting any --| borrow in the high-order position. The remaining meaningful --| slice from the first operand is copied into the difference, and --| the borrow, if any, is propagated. --| --| ERROR CHECKS/RESPONSES: None. --| --| NOTES: The sign and radix fields of parameter result may contain --| significant values. The procedure leaves these unchanged. --| The signs and radices of the operands are ignored. --| --======================================================================= PROCEDURE perform_subtraction (x, y : IN number; result : IN OUT number) IS -- Number borrowed from place to left borrow : carry_or_borrow; -- Digit position being operated upon pos : digit_range; BEGIN -- perform_subtraction IF (x.high_order_digit = y.high_order_digit) AND THEN (x.digit(1 .. x.high_order_digit) = y.digit(1 .. y.high_order_digit)) THEN -- Difference is zero -- Copy zero value result.high_order_digit := 1; result.digit(1) := 0; ELSE -- Result is non-zero -- Subtract digits in common between x and y borrow := 0; FOR position IN 1 .. y.high_order_digit LOOP IF (x.digit(position) - borrow < y.digit(position)) THEN result.digit(position) := x.radix + x.digit(position) - y.digit(position); borrow := 1; ELSE result.digit(position) := x.digit(position) - borrow - y.digit(position); borrow := 0; END IF; END LOOP; -- Copy remaining digits to result result.digit(y.high_order_digit+1 .. x.high_order_digit) := x.digit(y.high_order_digit+1 .. x.high_order_digit); -- Propagate borrow to high-order digit FOR position IN y.high_order_digit .. x.high_order_digit LOOP IF (borrow = 1) THEN IF (result.digit(position) = 0) THEN result.digit(position) := x.radix - 1; ELSE result.digit(position) := result.digit(position) - 1; borrow := 0; END IF; ELSE EXIT; END IF; END LOOP; -- Eliminate leading zeroes pos := x.high_order_digit; WHILE (result.digit(pos) = 0) LOOP pos := pos - 1; END LOOP; result.high_order_digit := pos; END IF; END perform_subtraction; BEGIN -- "-" IF (a.radix = b.radix) AND THEN (a.radix /= invalid_number_flag) AND THEN (b.radix /= invalid_number_flag) THEN --Subtraction is possible; compute difference IF (a.sign = b.sign) THEN -- Signs of operands equal -- -- Set radix result.radix := a.radix; IF (abs(a) <= abs(b)) THEN -- Since |b| >= |a|, compute digits of |b| - |a| perform_subtraction(b, a, result); -- Set sign (special case for zero) IF (a.sign = plus) THEN IF (result.high_order_digit = 1) AND THEN (result.digit(1) = 0) THEN result.sign := plus; ELSE result.sign := minus; END IF; ELSE result.sign := plus; END IF; ELSE -- Since |a| > |b|, compute digits of |a| - |b| perform_subtraction(a, b, result); -- Set sign IF (a.sign = plus) THEN result.sign := plus; ELSE result.sign := minus; END IF; END IF; ELSE -- Signs of operands different -- -- Compute difference using addition result := a + (-b); END IF; END IF; --- Return difference or invalid number RETURN result; END "-"; --========================================================================== --| --| FUNCTION NAME: numbers."+" (binary plus) --| --| ASSUMPTIONS/LIMITATIONS: Parameters are assumed canonical. --| --| ALGORITHM/STRATEGY: If the operands are valid, the signs of the --| operators are compared. If they are different, the sum is computed --| using numbers."abs" and numbers."-" (binary subtraction). If the --| signs are different, the operand with the larger number of digits --| is found, and procedure perform_addition is used to compute the digits --| of the sum. --| --| NOTES: None. --| --========================================================================== FUNCTION "+" (a, b : IN number) RETURN number IS -- Number where sum is computed result : number; --======================================================================= --| --| PROCEDURE NAME: numbers."+".perform_addition --| --| PURPOSE: To generate the digits of the sum of two multiple-precision --| integers. --| --| PROGRAMMER: Lionel Deimel DATE WRITTEN: 5/21/90 --| DATE OF LAST REVISION: 7/26/90 VERSION: 2.1 --| --| PARAMETERS: --| x (in) first operand --| --| y (in) second operand --| --| result (in out) on exit, contains digits and --| pointer to high-order-digit of --| sum; other fields are --| unchanged --| --| INPUT/OUTPUT: None. --| --| ASSUMPTIONS/LIMITATIONS: The operands are assumed to have --| legitimate values and to share the same radix. The first --| operand is assumed to have at least as many digits as that --| of the second. --| --| ALGORITHM/STRATEGY: The largest digit array slices of meaningful --| digits are added, and remaining digits of the first operand --| are copied to the sum. The carry from the first operation is --| then propagated. --| --| ERROR CHECKS/RESPONSES: None. --| --| NOTES: The sign and radix fields of parameter result may contain --| significant values. The procedure leaves these unchanged. --| The signs and radices of the operands are ignored. --| --======================================================================= PROCEDURE perform_addition (x, y : IN number; result : IN OUT number) IS -- Range for addition of two digits SUBTYPE digit_sum IS natural RANGE 0 .. (2*maximum_radix - 1); -- Number carried from place to right carry : carry_or_borrow; -- Sum of corresponding digits sum : digit_sum; BEGIN -- perform_addition -- Add digits in common between x and y carry := 0; FOR position IN 1 .. y.high_order_digit LOOP sum := x.digit(position) + y.digit(position) + carry; IF sum >= x.radix THEN result.digit(position) := sum - x.radix; carry := 1; ELSE result.digit(position) := sum; carry := 0; END IF; END LOOP; -- Copy remaining digits of x to result result.digit(y.high_order_digit+1 .. x.high_order_digit) := x.digit(y.high_order_digit+1 .. x.high_order_digit); -- Propagate carry to high-order digit FOR position IN y.high_order_digit+1 .. x.high_order_digit LOOP IF (carry = 1) THEN sum := result.digit(position) + carry; IF sum >= x.radix THEN result.digit(position) := sum - x.radix; carry := 1; ELSE result.digit(position) := sum; carry := 0; END IF; ELSE EXIT; END IF; END LOOP; -- Handle carry from high-order digit, if any IF (carry = 1) THEN IF (x.high_order_digit < maximum_number_length) THEN result.high_order_digit := x.high_order_digit + 1; result.digit(x.high_order_digit + 1) := carry; ELSE result.radix := invalid_number_flag; END IF; ELSE result.high_order_digit := x.high_order_digit; END IF; END perform_addition; BEGIN -- "+" IF (a.radix = b.radix) AND THEN (a.radix /= invalid_number_flag) AND THEN (b.radix /= invalid_number_flag) THEN -- Addition is possible; compute sum IF (a.sign = b.sign) THEN -- Signs of operands equal -- -- Set sign and radix result.sign := a.sign; result.radix := a.radix; IF (a.high_order_digit >= b.high_order_digit) THEN perform_addition(a, b, result); ELSE perform_addition(b, a, result); END IF; ELSE -- Signs of operands different -- -- Compute sum using subtraction IF (a.sign = plus) THEN result := a - abs(b); ELSE result := b - abs(a); END IF; END IF; END IF; -- Return sum or invalid number RETURN result; END "+"; --========================================================================== --| --| FUNCTION NAME: numbers."*" --| --| ASSUMPTIONS/LIMITATIONS: Parameter a is assumed canonical. --| --| ALGORITHM/STRATEGY: If operands are valid, multiplication is performed. --| A zero result is handled as a special case. In the general case, --| the sign and base are determined by the multiple-precision factor. --| The product is computed from right to left, and overflow is checked --| for before any carry is propagated. --| --| NOTES: None. --| --========================================================================== FUNCTION "*" (f : IN radix_digit; a : IN number) RETURN number IS -- Range for single digit product SUBTYPE digit_product IS natural RANGE 0 .. a.radix**2 - a.radix; -- Range for digits in base of operation SUBTYPE local_radix_digit IS radix_digit RANGE 0 .. a.radix -1; -- Carry from multiplication of one digit carry : local_radix_digit; -- Result of single digit multiplication plus carry product : digit_product; -- Number where product is computed result : number; BEGIN -- "*" IF (a.radix /= invalid_number_flag AND f