1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2012-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(asn1rtt_real_common).
21
22-export([encode_real/1,decode_real/1,
23	 ber_encode_real/1]).
24
25%%============================================================================
26%%
27%% Real value, ITU_T X.690 Chapter 8.5
28%%============================================================================
29%%
30%% encode real value
31%%============================================================================
32
33ber_encode_real(0) ->
34    {[],0};
35ber_encode_real('PLUS-INFINITY') ->
36    {[64],1};
37ber_encode_real('MINUS-INFINITY') ->
38    {[65],1};
39ber_encode_real(Val) when is_tuple(Val); is_list(Val) ->
40    encode_real(Val).
41
42%%%%%%%%%%%%%%
43%% only base 2 encoding!
44%% binary encoding:
45%% +------------+ +------------+  +-+-+-+-+---+---+
46%% | (tag)9     | |  n + p + 1 |  |1|S|BB |FF |EE |
47%% +------------+ +------------+  +-+-+-+-+---+---+
48%%
49%%	 +------------+	   +------------+
50%%	 |            |	   |            |
51%%	 +------------+	...+------------+
52%%	     n octets for exponent
53%%
54%%	 +------------+	   +------------+
55%%	 |            |	   |            |
56%%	 +------------+	...+------------+
57%%	     p octets for pos mantissa
58%%
59%% S is 0 for positive sign
60%%      1 for negative sign
61%% BB: encoding base, 00 = 2, (01 = 8, 10 = 16)
62%%                             01 and 10 not used
63%% FF: scale factor 00 = 0 (used in base 2 encoding)
64%% EE: encoding of the exponent:
65%%     00 - on the following octet
66%%     01 - on the 2 following octets
67%%     10 - on the 3 following octets
68%%     11 - encoding of the length of the two's-complement encoding of
69%%          exponent on the following octet, and two's-complement
70%%          encoding of exponent on the other octets.
71%%
72%% In DER and base 2 encoding the mantissa is encoded as value 0 or
73%% bit shifted until it is an odd number. Thus, do this for BER as
74%% well.
75
76encode_real(Real) ->
77    encode_real([], Real).
78
79encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 ->
80%%    io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]),
81    {Man,ExpAdd} = truncate_zeros(Mantissa), %% DER adjustment
82    Exp = Exponent + ExpAdd,
83    OctExp = if Exp >= 0 -> list_to_binary(encode_pos_integer(Exp, []));
84		true     -> list_to_binary(encode_neg_integer(Exp, []))
85	     end,
86%%    ok = io:format("OctExp: ~w~n",[OctExp]),
87    SignBit = if  Man > 0 -> 0;  % bit 7 is pos or neg, no Zeroval
88		  true -> 1
89	      end,
90%%    ok = io:format("SignBitMask: ~w~n",[SignBitMask]),
91    SFactor = 0,
92    OctExpLen = byte_size(OctExp),
93    if OctExpLen > 255 ->
94	    exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}});
95       true  -> true %% make real assert later..
96    end,
97    {LenCode, EOctets} = case OctExpLen of   % bit 2,1
98			     1 -> {0, OctExp};
99			     2 -> {1, OctExp};
100			     3 -> {2, OctExp};
101			     _ -> {3, <<OctExpLen, OctExp/binary>>}
102			 end,
103    BB = 0, %% 00 for base 2
104    FirstOctet = <<1:1,SignBit:1,BB:2,SFactor:2,LenCode:2>>,
105    OctMantissa = if Man > 0 -> list_to_binary(real_mininum_octets(Man));
106		     true    -> list_to_binary(real_mininum_octets(-(Man))) % signbit keeps track of sign
107		  end,
108    %%    ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]),
109    <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>;
110encode_real(C, {Mantissa,Base,Exponent})
111  when Base =:= 10, is_integer(Mantissa), is_integer(Exponent) ->
112    %% always encode as NR3 due to DER on the format
113    %% mmmm.Eseeee where
114    %% m := digit
115    %% s := '-' | '+' | []
116    %% '+' only allowed in +0
117    %% e := digit
118    %% ex: 1234.E-5679
119    ManStr = integer_to_list(Mantissa),
120
121    encode_real_as_string(C,ManStr,Exponent);
122encode_real(_C, {_,Base,_}) ->
123    exit({error,{asn1, {encode_real_non_supported_encoding, Base}}});
124%% base 10
125encode_real(C, Real) when is_list(Real) ->
126    %% The Real string may come in as a NR1, NR2 or NR3 string.
127    {Mantissa, Exponent} =
128	case string:lexemes(Real,"Ee") of
129	    [NR2] ->
130		{NR2,0};
131	    [NR3MB,NR3E] ->
132		%% remove beginning zeros
133		{NR3MB,list_to_integer(NR3E)}
134	end,
135
136    %% .Decimal | Number | Number.Decimal
137    ZeroDecimal =
138	fun("0") -> "";
139	   (L) -> L
140	end,
141    {NewMantissa,LenDecimal} =
142	case Mantissa of
143	    [$.|Dec] ->
144		NewMan = remove_trailing_zeros(Dec),
145		{NewMan,length(ZeroDecimal(NewMan))};
146	    _ ->
147		case string:lexemes(Mantissa,",.") of
148		    [Num] -> %% No decimal-mark
149			{integer_to_list(list_to_integer(Num)),0};
150		    [Num,Dec] ->
151			NewDec = ZeroDecimal(remove_trailing_zeros(Dec)),
152			NewMan = integer_to_list(list_to_integer(Num)) ++ NewDec,
153			{integer_to_list(list_to_integer(NewMan)),
154			 length(NewDec)}
155		end
156	end,
157
158    encode_real_as_string(C, NewMantissa, Exponent - LenDecimal).
159
160encode_real_as_string(_C, Mantissa, Exponent)
161  when is_list(Mantissa), is_integer(Exponent) ->
162    %% Remove trailing zeros in Mantissa and add this to Exponent
163    TruncMant = remove_trailing_zeros(Mantissa),
164
165    ExpIncr = length(Mantissa) - length(TruncMant),
166
167    ExpStr = integer_to_list(Exponent + ExpIncr),
168
169    ExpBin =
170	case ExpStr of
171	    "0" ->
172		<<"E+0">>;
173	    _ ->
174		ExpB = list_to_binary(ExpStr),
175		<<$E,ExpB/binary>>
176	end,
177    ManBin = list_to_binary(TruncMant),
178    NR3 = 3,
179    <<NR3,ManBin/binary,$.,ExpBin/binary>>.
180
181remove_trailing_zeros(IntStr) ->
182    case lists:dropwhile(fun($0)-> true;
183			    (_) -> false
184			 end, lists:reverse(IntStr)) of
185	[] ->
186	    "0";
187	ReversedIntStr ->
188	    lists:reverse(ReversedIntStr)
189    end.
190
191truncate_zeros(Num) ->
192    truncate_zeros(Num, 0).
193truncate_zeros(0, Sum) ->
194    {0,Sum};
195truncate_zeros(M, Sum) ->
196    case M band 16#f =:= M band 16#e of
197	true -> truncate_zeros(M bsr 1, Sum+1);
198	_ -> {M,Sum}
199    end.
200
201
202%%============================================================================
203%% decode real value
204%%
205%% decode_real([OctetBufferList], tuple|value, tag|notag) ->
206%%  {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0,
207%%     RestBuff}
208%%
209%% only for base 2 decoding sofar!!
210%%============================================================================
211
212decode_real(Buffer) ->
213    Sz = byte_size(Buffer),
214    {RealVal,<<>>,Sz} = decode_real2(Buffer, [], Sz, 0),
215    RealVal.
216
217decode_real2(Buffer, _C, 0, _RemBytes) ->
218    {0,Buffer};
219decode_real2(Buffer0, _C, Len, RemBytes1) ->
220    <<First, Buffer2/binary>> = Buffer0,
221    if
222	First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2};
223	First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2};
224	First =:= 1 orelse First =:= 2 orelse First =:= 3 ->
225	    %% charcter string encoding of base 10
226	    {NRx,Rest} = split_binary(Buffer2,Len-1),
227	    {binary_to_list(NRx),Rest,Len};
228	true ->
229	    %% have some check here to verify only supported bases (2)
230	    %% not base 8 or 16
231	    <<_B7:1,Sign:1,BB:2,_FF:2,EE:2>> = <<First>>,
232	    Base =
233		case BB of
234		    0 -> 2;  % base 2, only one so far
235		    _ -> exit({error,{asn1, {non_supported_base, BB}}})
236		end,
237	    {FirstLen, {Exp, Buffer3,_Rb2}, RemBytes2} =
238		case EE of
239		    0 -> {2, decode_integer2(1, Buffer2, RemBytes1), RemBytes1+1};
240		    1 -> {3, decode_integer2(2, Buffer2, RemBytes1), RemBytes1+2};
241		    2 -> {4, decode_integer2(3, Buffer2, RemBytes1), RemBytes1+3};
242		    3 ->
243			<<ExpLen1,RestBuffer/binary>> = Buffer2,
244			{ ExpLen1 + 2,
245			  decode_integer2(ExpLen1, RestBuffer, RemBytes1),
246			  RemBytes1+ExpLen1}
247		end,
248	    %%	    io:format("FirstLen: ~w, Exp: ~w, Buffer3: ~w ~n",
249
250	    Length = Len - FirstLen,
251	    <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3,
252	    {{Mantissa, Buffer4}, RemBytes3} =
253		if Sign =:= 0 ->
254			%%			io:format("sign plus~n"),
255			{{LongInt, RestBuff}, 1 + Length};
256		   true ->
257			%%			io:format("sign minus~n"),
258			{{-LongInt, RestBuff}, 1 + Length}
259		end,
260	    {{Mantissa, Base, Exp}, Buffer4, RemBytes2+RemBytes3}
261    end.
262
263encode_pos_integer(0, [B|_Acc]=L) when B < 128 ->
264    L;
265encode_pos_integer(N, Acc) ->
266    encode_pos_integer(N bsr 8, [N band 16#ff| Acc]).
267
268encode_neg_integer(-1, [B1|_T]=L) when B1 > 127 ->
269    L;
270encode_neg_integer(N, Acc) ->
271    encode_neg_integer(N bsr 8, [N band 16#ff|Acc]).
272
273
274%% Val must be >= 0
275real_mininum_octets(Val) ->
276    real_mininum_octets(Val, []).
277
278real_mininum_octets(0, Acc) ->
279    Acc;
280real_mininum_octets(Val, Acc) ->
281    real_mininum_octets(Val bsr 8, [Val band 16#FF | Acc]).
282
283%% decoding postitive integer values.
284decode_integer2(Len, <<0:1,_:7,_Bs/binary>> = Bin, RemovedBytes) ->
285    <<Int:Len/unit:8,Buffer2/binary>> = Bin,
286    {Int,Buffer2,RemovedBytes};
287%% decoding negative integer values.
288decode_integer2(Len, <<1:1,B2:7,Bs/binary>>, RemovedBytes)  ->
289    <<N:Len/unit:8,Buffer2/binary>> = <<B2,Bs/binary>>,
290    Int = N - (1 bsl (8 * Len - 1)),
291    {Int,Buffer2,RemovedBytes}.
292