1%%--------------------------------------------------------------------
2%%
3%% %CopyrightBegin%
4%%
5%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
6%%
7%% Licensed under the Apache License, Version 2.0 (the "License");
8%% you may not use this file except in compliance with the License.
9%% You may obtain a copy of the License at
10%%
11%%     http://www.apache.org/licenses/LICENSE-2.0
12%%
13%% Unless required by applicable law or agreed to in writing, software
14%% distributed under the License is distributed on an "AS IS" BASIS,
15%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
16%% See the License for the specific language governing permissions and
17%% limitations under the License.
18%%
19%% %CopyrightEnd%
20%%
21%%--------------------------------------------------------------------
22-module(m_i_impl).
23
24-export([marshal_ll/3,marshal_ull/3,
25	 marshal_l/3,marshal_ul/3,
26	 marshal_s/3,marshal_us/3,
27	 marshal_c/3,marshal_wc/3,
28	 strcat/3,
29	 marshal_any_3/4,marshal_any_2/3]).
30-export([init/1,terminate/2,code_change/3]).
31
32-include("m.hrl").
33
34-define(TK_M_S, {tk_struct,
35		 "IDL:m/s:1.0",
36		 "s",
37		 [{"ll_x",tk_longlong},
38		  {"ull_x",tk_ulonglong},
39		  {"ll_y",tk_longlong},
40		  {"ll_z",tk_longlong},
41		  {"ull_z",tk_ulonglong},
42		  {"l_x",tk_long},
43		  {"ul_x",tk_ulong},
44		  {"l_y",tk_long},
45		  {"l_z",tk_long},
46		  {"ul_z",tk_ulong},
47		  {"s_x",tk_short},
48		  {"us_x",tk_ushort},
49		  {"s_y",tk_short},
50		  {"s_z",tk_short},
51		  {"us_z",tk_ushort},
52		  {"c_x",tk_char},
53		  {"c_y",tk_char},
54		  {"c_z",tk_char},
55		  {"wc_x",tk_wchar},
56		  {"wc_y",tk_wchar},
57		  {"wc_z",tk_wchar}|_]}).
58
59
60
61marshal_ll(State, #m_s{ll_x = X, ll_y = Y}=_A, B) when integer(B) ->
62    R = (X - Y)*B,
63    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
64    {reply, R, State}.
65
66marshal_ull(State, #m_s{ull_x = X, ll_y = Y}=_A, B) when integer(B) ->
67    R = (X - Y)*B,
68    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
69    {reply, R, State}.
70
71
72marshal_l(State, #m_s{l_x = X, l_y = Y}=_A, B) when integer(B) ->
73    R = (X - Y)*B,
74    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
75    {reply, R, State}.
76
77marshal_ul(State, #m_s{ul_x = X, l_y = Y}=_A, B) when integer(B) ->
78    R = (X - Y)*B,
79    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
80    {reply, R, State}.
81
82
83marshal_s(State, #m_s{s_x = X, s_y = Y}=_A, B) when integer(B) ->
84    R = (X - Y)*B,
85    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
86    {reply, R, State}.
87
88marshal_us(State, #m_s{us_x = X, s_y = Y}=_A, B) when integer(B) ->
89    R = (X - Y)*B,
90    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
91    {reply, R, State}.
92
93
94marshal_c(State, #m_s{c_x = X, c_y = Y}=_A, B) when integer(B) ->
95    R = (X - Y)*B,
96    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
97    {reply, R, State}.
98
99marshal_wc(State, #m_s{wc_x = X, wc_y = Y}=_A, B) when integer(B) ->
100    R = (X - Y)*B,
101    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
102    {reply, R, State}.
103
104strcat(State, A, B) when list(A), list(B) ->
105    R = A++B,
106    io:format("~p", [{?MODULE,?LINE,[length(A),length(B),A,B,R]}]),
107    {reply, R, State};
108strcat(State, A, B) ->
109    io:format("~p", [{?MODULE,?LINE,[A,B]}]),
110    {reply, [], State}.
111
112marshal_any_3(State, {any,TkX,_}=X, {any,_,_}=Y, B) when integer(B) ->
113    R = any(mul(sub(any(X), any(Y)), B), TkX),
114    io:format("~p", [{?MODULE,?LINE,[X,Y,B,R]}]),
115    {reply, R, State}.
116
117marshal_any_2(State,
118	      {any,TkA,#m_s{ll_x=LL_X, ull_x=ULL_X, ll_y=LL_Y,
119			    l_x=L_X, ul_x=UL_X, l_y=L_Y,
120			    s_x=S_X, us_x=US_X, s_y=S_Y,
121			    c_x=C_X, c_y=C_Y,
122			    wc_x=WC_X, wc_y=WC_Y} = A},
123	      B) when integer(B) ->
124    {check_type_code,?TK_M_S} = {check_type_code,TkA},
125    ULL_Z = (ULL_X - LL_Y) * B,
126    LL_Z = (LL_X - LL_Y) * B,
127    UL_Z = (UL_X - L_Y) * B,
128    L_Z = (L_X - L_Y) * B,
129    US_Z = (US_X - S_Y) * B,
130    S_Z = (S_X - S_Y) * B,
131    C_Z = (C_X - C_Y) * B,
132    WC_Z = (WC_X - WC_Y) * B,
133    R = A#m_s{ll_z=LL_Z, ull_z=ULL_Z,
134	      l_z=L_Z, ul_z=UL_Z,
135	      s_z=S_Z, us_z=US_Z,
136	      c_z=C_Z, wc_z=WC_Z},
137    io:format("~p", [{?MODULE,?LINE,[A,B,R]}]),
138    {reply, {any,TkA,R}, State}.
139
140
141
142init(_Env) ->
143    {ok, []}.
144
145terminate(_Reason, _State) ->
146    ok.
147
148code_change(_OldVsn, State, _Extra) ->
149    {ok, State}.
150
151
152any({any,tk_longlong,X}) -> X;
153any({any,tk_long,X}) -> X;
154any({any,tk_short,X}) -> X;
155any({any,tk_ulonglong,X}) -> X;
156any({any,tk_ulong,X}) -> X;
157any({any,tk_ushort,X}) -> X;
158any({any,tk_char,X}) -> X;
159any({any,tk_wchar,X}) -> X.
160
161any(X, Tk) when integer(X) -> {any,Tk,X}.
162
163sub(X, Y) when integer(X), integer(Y) ->
164    X - Y.
165
166mul(X, Y) when integer(X), integer(Y) ->
167    X * Y.
168
169napp(0, L) -> L;
170napp(N, L) when integer(N), N >= 1 -> napp(N-1, L)++L.
171