aboutsummaryrefslogtreecommitdiffstats
path: root/lib/orber/src/fixed.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/orber/src/fixed.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/orber/src/fixed.erl')
-rw-r--r--lib/orber/src/fixed.erl305
1 files changed, 305 insertions, 0 deletions
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 -------------------------------------
+%%-----------------------------------------------------------------