From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/orber/src/fixed.erl | 305 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 305 insertions(+) create mode 100644 lib/orber/src/fixed.erl (limited to 'lib/orber/src/fixed.erl') diff --git a/lib/orber/src/fixed.erl b/lib/orber/src/fixed.erl new file mode 100644 index 0000000000..255c86c22a --- /dev/null +++ b/lib/orber/src/fixed.erl @@ -0,0 +1,305 @@ +%%-------------------------------------------------------------------- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%%-------------------------------------------------------------------- +%% File : fixed.erl +%% Purpose : +%%-------------------------------------------------------------------- + +-module(fixed). + +-include_lib("orber/include/corba.hrl"). + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- +-export([create/3, add/2, subtract/2, divide/2, multiply/2, unary_minus/1, + get_typecode/1]). + +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%----------------------------------------------------------------- +%% Definitions +%%----------------------------------------------------------------- +-define(get_max(__X, __Y), if __X > __Y -> __X; true -> __Y end). +-define(get_min(__X, __Y), if __X > __Y -> __Y; true -> __X end). + +-define(BASE, 100000000000000000000000000000000). +-define(FIXED_MAX, 9999999999999999999999999999999). +-define(FIXED_MIN, -9999999999999999999999999999999). + +-define(DEBUG_LEVEL, 5). + +%%----------------------------------------------------------------- +%% External functions +%%----------------------------------------------------------------- +create(Digits, Scale, Value) when is_integer(Digits) andalso Digits >= 0 andalso Digits < 32 andalso + is_integer(Scale) andalso Scale >= 0 andalso Digits >= Scale andalso + is_integer(Value) andalso Value =< ?FIXED_MAX andalso + Value >= ?FIXED_MIN -> + case count_digits(abs(Value)) of + Dig when Dig =< Digits -> + #fixed{digits = Digits, scale = Scale, value = Value}; + Overflow -> + orber:dbg("[~p] fixed:create(~p, ~p, ~p).~n" + "The Value exceeds the Digits limit: ~p, ~p", + [?LINE, Digits, Scale, Value, Digits, Overflow], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}) + end; +create(Digits, Scale, Value) -> + orber:dbg("[~p] fixed:add(~p, ~p, ~p).~n" + "At least one of the supplied arguments is incorrect.~n" + "Digits and Scale must be a positive integer with the following~n" + "limits:~n" + " * 0 =< Digits < 32~n" + " * Digits >= Scale~n" + " * Value range +/- 9999999999999999999999999999999", + [?LINE, Digits, Scale, Value], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + + +get_typecode(#fixed{digits = Digits, scale = Scale}) -> + {tk_fixed, Digits, Scale}; +get_typecode(Other) -> + orber:dbg("[~p] fixed:get_typecode(~p). +The supplied argument is not a Fixed Type.", [?LINE, Other], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + +add(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = D2, scale = S2, value = V2}) -> + Scale = ?get_max(S1, S2), + Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, + %% We must normalize the values before adding. Why? + %% 4.23 and 5.2 are represented as 423 and 52. To be able to get the + %% correct result we must add 4230 and 5200 == 9430. + {PV1, PV2} = normalize(S1, V1, S2, V2), + check_fixed_overflow(#fixed{digits = Digits, + scale = Scale, + value = (PV1 + PV2)}); +add(F1, F2) -> + orber:dbg("[~p] fixed:add(~p, ~p).~n" + "At least one of the supplied arguments is not a Fixed Type.", + [?LINE, F1, F2], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + + +subtract(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = D2, scale = S2, value = V2}) -> + Scale = ?get_max(S1, S2), + Digits = ?get_max((D1-S1), (D2-S2)) + Scale +1, + {PV1, PV2} = normalize(S1, V1, S2, V2), + check_fixed_overflow(#fixed{digits = Digits, + scale = Scale, + value = (PV1 - PV2)}); +subtract(F1, F2) -> + orber:dbg("[~p] fixed:subtract(~p, ~p).~n" + "At least one of the supplied arguments is not a Fixed Type.", + [?LINE, F1, F2], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + +divide(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = _D2, scale = S2, value = V2}) -> + {PV1, PV2} = normalize(S1, V1, S2, V2), + DigitsMin = (D1-S1+S2), + R1 = (PV1 div PV2), + R2 = (R1*?BASE + (PV1 rem PV2) * (?BASE div PV2)), + {Result2, Sinf} = delete_zeros_value(R2, 0, R1), + check_fixed_overflow(#fixed{digits = DigitsMin + Sinf, scale = Sinf, + value = Result2}); +divide(F1, F2) -> + orber:dbg("[~p] fixed:divide(~p, ~p).~n" + "At least one of the supplied arguments is not a Fixed Type.", + [?LINE, F1, F2], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + + +multiply(#fixed{digits = D1, scale = S1, value = V1}, + #fixed{digits = D2, scale = S2, value = V2}) -> + check_fixed_overflow(#fixed{digits = (D1+D2), + scale = (S1+S2), + value = V1*V2}); +multiply(F1, F2) -> + orber:dbg("[~p] fixed:multiply(~p, ~p).~n" + "At least one of the supplied arguments is not a Fixed Type.", + [?LINE, F1, F2], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + +unary_minus(Fixed) when is_record(Fixed, fixed) -> + Fixed#fixed{value = -(Fixed#fixed.value)}; +unary_minus(Fixed) -> + orber:dbg("[~p] fixed:unary_minus(~p).~n" + "The supplied argument is not a Fixed Type.", + [?LINE, Fixed], ?DEBUG_LEVEL), + corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). + + + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- +%% Pretty?! No, but since we now the upper-limit this is the fastest way +%% to calculate 10^x +power(0) -> 1; +power(1) -> 10; +power(2) -> 100; +power(3) -> 1000; +power(4) -> 10000; +power(5) -> 100000; +power(6) -> 1000000; +power(7) -> 10000000; +power(8) -> 100000000; +power(9) -> 1000000000; +power(10) -> 10000000000; +power(11) -> 100000000000; +power(12) -> 1000000000000; +power(13) -> 10000000000000; +power(14) -> 100000000000000; +power(15) -> 1000000000000000; +power(16) -> 10000000000000000; +power(17) -> 100000000000000000; +power(18) -> 1000000000000000000; +power(19) -> 10000000000000000000; +power(20) -> 100000000000000000000; +power(21) -> 1000000000000000000000; +power(22) -> 10000000000000000000000; +power(23) -> 100000000000000000000000; +power(24) -> 1000000000000000000000000; +power(25) -> 10000000000000000000000000; +power(26) -> 100000000000000000000000000; +power(27) -> 1000000000000000000000000000; +power(28) -> 10000000000000000000000000000; +power(29) -> 100000000000000000000000000000; +power(30) -> 1000000000000000000000000000000; +power(31) -> 10000000000000000000000000000000; +power(_) -> 10000000000000000000000000000000. + + + +%% If the result of an operation (+, -, * or /) causes overflow we use this +%% operation. However, since these calculations are performed during compiletime, +%% shouldn't the IDL-specification be changed to not cause overflow?! But, since +%% the OMG standard allows this we must support it. +check_fixed_overflow(#fixed{digits = Digits, scale = Scale, value = Value}) -> + case count_digits(abs(Value)) of + overflow -> + {N, NewVal} = cut_overflow(0, Value), + if + N > Scale -> + #fixed{digits = 31, scale = 0, value = NewVal}; + true -> + NewScale = Scale - N, + {NewVal2, Removed} = delete_zeros(NewVal, NewScale), + #fixed{digits = 31, scale = NewScale-Removed, value = NewVal2} + end; + Count when Count > Digits -> + Diff = Count-Digits, + if + Diff > Scale -> + #fixed{digits = Digits, scale = 0, + value = (Value div power(Diff))}; + true -> + NewScale = Scale-Diff, + {NewVal, Removed} = delete_zeros((Value div power(Diff)), NewScale), + #fixed{digits = Digits-Removed, + scale = NewScale-Removed, + value = NewVal} + end; + Count -> + {NewVal, Removed} = delete_zeros(Value, Scale), + #fixed{digits = Count-Removed, scale = Scale-Removed, value = NewVal} + end. + +%% This function see to that the values are of the same baase. +normalize(S, V1, S, V2) -> + {V1, V2}; +normalize(S1, V1, S2, V2) when S1 > S2 -> + {V1, V2*power(S1-S2)}; +normalize(S1, V1, S2, V2) -> + {V1*power(S2-S1), V2}. + +%% If we have access to the integer part of the fixed type we use this +%% operation to remove all trailing zeros. If we know the scale, length of +%% fraction part, we can use delete_zeros as well. But, after a division +%% it's hard to know the scale and we don't need to calcluate the integer part. +delete_zeros_value(0, N, _) -> + {0, 32-N}; +delete_zeros_value(X, N, M) when X > M, (X rem 10) == 0 -> + delete_zeros_value((X div 10), N+1, M); +delete_zeros_value(X, N, _) -> + {X, 32-N}. + +%% If we know the exact scale of a fixed type we can use this operation to +%% remove all trailing zeros. +delete_zeros(0, _) -> + {0,0}; +delete_zeros(X, Max) -> + delete_zeros(X, 0, Max). +delete_zeros(X, Max, Max) -> + {X, Max}; +delete_zeros(X, N, Max) when (X rem 10) == 0 -> + delete_zeros((X div 10), N+1, Max); +delete_zeros(X, N, _) -> + {X, N}. + +cut_overflow(N, X) when X > ?FIXED_MAX -> + cut_overflow(N+1, (X div 10)); +cut_overflow(N, X) -> + {N, X}. + +%% A fast way to check the size of a fixed data type. +count_digits(X) when X > ?FIXED_MAX -> overflow; +count_digits(X) when X >= 1000000000000000000000000000000 -> 31; +count_digits(X) when X >= 100000000000000000000000000000 -> 30; +count_digits(X) when X >= 10000000000000000000000000000 -> 29; +count_digits(X) when X >= 1000000000000000000000000000 -> 28; +count_digits(X) when X >= 100000000000000000000000000 -> 27; +count_digits(X) when X >= 10000000000000000000000000 -> 26; +count_digits(X) when X >= 1000000000000000000000000 -> 25; +count_digits(X) when X >= 100000000000000000000000 -> 24; +count_digits(X) when X >= 10000000000000000000000 -> 23; +count_digits(X) when X >= 1000000000000000000000 -> 22; +count_digits(X) when X >= 100000000000000000000 -> 21; +count_digits(X) when X >= 10000000000000000000 -> 20; +count_digits(X) when X >= 1000000000000000000 -> 19; +count_digits(X) when X >= 100000000000000000 -> 18; +count_digits(X) when X >= 10000000000000000 -> 17; +count_digits(X) when X >= 1000000000000000 -> 16; +count_digits(X) when X >= 100000000000000 -> 15; +count_digits(X) when X >= 10000000000000 -> 14; +count_digits(X) when X >= 1000000000000 -> 13; +count_digits(X) when X >= 100000000000 -> 12; +count_digits(X) when X >= 10000000000 -> 11; +count_digits(X) when X >= 1000000000 -> 10; +count_digits(X) when X >= 100000000 -> 9; +count_digits(X) when X >= 10000000 -> 8; +count_digits(X) when X >= 1000000 -> 7; +count_digits(X) when X >= 100000 -> 6; +count_digits(X) when X >= 10000 -> 5; +count_digits(X) when X >= 1000 -> 4; +count_digits(X) when X >= 100 -> 3; +count_digits(X) when X >= 10 -> 2; +count_digits(_X) -> 1. + +%%----------------------------------------------------------------- +%%------------- END OF MODULE ------------------------------------- +%%----------------------------------------------------------------- -- cgit v1.2.3