1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2020. 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%%
21
22%%------------------------------------------------------------
23%%
24%% This module is a main module for generation of C code, both
25%% for ic_cclient and ic_cserver.
26%%
27%% The former role of this module (ic_cbe) was to generate client
28%% code only.
29%%
30-module(ic_cbe).
31
32-export([emit_malloc_size_stmt/7, emit_encoding_stmt/6,
33	 emit_encoding_stmt/7, emit_decoding_stmt/10,
34	 emit_decoding_stmt/11, emit_dealloc_stmts/3,
35	 mk_variable_name/1, mk_c_type/3, mk_c_type/4, mk_c_type2/3,
36	 is_variable_size/1, is_variable_size/3, mk_dim/1,
37	 mk_slice_dim/1, emit_tmp_variables/1, store_tmp_decl/2,
38	 extract_info/3, normalize_type/1]).
39
40%%------------------------------------------------------------
41%%
42%% Internal stuff
43%%
44%%------------------------------------------------------------
45
46-import(ic_codegen, [emit/2, emit/3, emit/4, emit_c_enc_rpt/4, emit_c_dec_rpt/4]).
47
48-include("icforms.hrl").
49-include ("ic.hrl").
50
51%%------------------------------------------------------------
52%%    ENCODING
53%%------------------------------------------------------------
54
55emit_encoding_stmt(G, N, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id ->
56    case mk_c_type(G, N, T, evaluate_not) of
57	"erlang_pid" ->
58	    %% Note prefix: oe_ei
59	    emit(Fd, "  if ((oe_error_code = "
60		 "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n",
61		 [LName]),
62	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
63	    emit(Fd, "    return oe_error_code;\n  }\n");
64	"erlang_port" ->
65	    %% Note prefix: oe_ei
66	    emit(Fd, "  if ((oe_error_code = "
67		 "oe_ei_encode_port(oe_env, ~s)) < 0) {\n",
68		 [LName]),
69	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
70	    emit(Fd, "    return oe_error_code;\n}  \n");
71	"erlang_ref" ->
72	    %% Note prefix: oe_ei
73	    emit(Fd, "  if ((oe_error_code = "
74		 "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n",
75		 [LName]),
76	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
77	    emit(Fd, "    return oe_error_code;\n  }\n");
78	"ic_erlang_term*" ->
79	    emit(Fd, "  if ((oe_error_code = "
80		 "oe_ic_encode_term(oe_env, ~s)) < 0) {\n",
81		 [LName]),
82	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
83	    emit(Fd, "    return oe_error_code;\n  }\n");
84	{enum, FSN} ->
85	    emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer);
86	FSN ->
87	    emit_encoding_stmt(G, N, Fd, FSN, LName, OutBuffer)
88    end;
89
90%% XXX T is a string
91emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer)  when is_list(T) ->
92    %% Already a fullscoped name
93    Type = ictype:name2type(G,T),
94    case ictype:isBasicType(Type) of
95	true ->
96	    emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName);
97	false ->
98	    emit(Fd, "  if ((oe_error_code = ~s~s(oe_env, ~s))"
99		 " < 0) {\n",
100		 [ic_util:mk_oe_name(G, "encode_"), T, LName]),
101	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]), % XXX list
102	    emit(Fd, "    return oe_error_code;\n  }\n")
103    end;
104emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer)  when is_record(T, string) ->
105    %% Note prefix: oe_ei
106    emit(Fd, "  if ((oe_error_code = oe_ei_encode_string(oe_env, "
107	 " ~s)) < 0) {\n",
108	 [LName]),
109    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
110    emit(Fd, "    return oe_error_code;\n  }\n");
111emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) when is_record(T, wstring) ->
112    %% Note prefix: oe_ei
113    emit(Fd, "  if ((oe_error_code = oe_ei_encode_wstring(oe_env, "
114	 "~s)) < 0) {\n",
115	 [LName]),
116    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
117    emit(Fd, "    return oe_error_code;\n  }\n");
118emit_encoding_stmt(G, N, Fd, T, LName, _OutBuffer) ->
119    case normalize_type(T) of
120	{basic, Type} ->
121	    emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName);
122	%% XXX Why only returns?
123	{void, _} ->
124	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
125	    emit(Fd, "    return oe_error_code;\n  }\n");
126	{sequence, _, _} ->
127	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
128	    emit(Fd, "    return oe_error_code;\n  }\n");
129	{_ArrayType, {array, _, _}} ->
130	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
131	    emit(Fd, "    return oe_error_code;\n  }\n");
132	{union, _, _, _, _} ->
133	    %% Union as a member in struct !
134	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
135	    emit(Fd, "    return oe_error_code;\n  }\n");
136	{struct, _, _, _} ->
137	    %% Struct as a member in struct !
138	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
139	    emit(Fd, "    return oe_error_code;\n  }\n");
140	_ ->
141	    ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
142    end.
143
144%% Arity = 7.
145%%
146emit_encoding_stmt(G, N, X, Fd, T, LName, OutBuffer) when element(1, T) == scoped_id ->
147    case mk_c_type(G, N, T, evaluate_not) of
148	"erlang_pid" ->
149	    %% Note prefix: oe_ei
150	    emit(Fd, "  if ((oe_error_code = "
151		 "oe_ei_encode_pid(oe_env, ~s)) < 0) {\n",
152		 [LName]),
153	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
154	    emit(Fd, "    return oe_error_code;\n  }\n");
155	"erlang_port" ->
156	    %% Note prefix: oe_ei
157	    emit(Fd, "  if ((oe_error_code = "
158		 "oe_ei_encode_port(oe_env, ~s)) < 0) {\n",
159		 [LName]),
160	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
161	    emit(Fd, "    return oe_error_code;\n  }\n");
162	"erlang_ref" ->
163	    %% Note prefix: oe_ei
164	    emit(Fd, "  if ((oe_error_code = "
165		 "oe_ei_encode_ref(oe_env, ~s)) < 0) {\n",
166		 [LName]),
167	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
168	    emit(Fd, "    return oe_error_code;\n  }\n");
169	"ic_erlang_term*" ->
170	    emit(Fd, "  if ((oe_error_code = "
171		 "oe_ic_encode_term(oe_env, ~s)) < 0) {\n",
172		 [LName]),
173	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
174	    emit(Fd, "    return oe_error_code;\n  }\n");
175	{enum, FSN} ->
176	    emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer);
177	FSN ->
178	    emit_encoding_stmt(G, N, X, Fd, FSN, LName, OutBuffer)
179    end;
180
181%% XXX T is a string
182emit_encoding_stmt(G, N, X, Fd, T, LName, _OutBuffer) when is_list(T) ->
183    %% Already a fullscoped name
184    case get_param_tk(LName,X) of
185	error ->
186	    emit(Fd, "  if ((oe_error_code = "
187		 "~s~s(oe_env, ~s)) < 0) {\n",
188		 [ic_util:mk_oe_name(G, "encode_"), T, LName]),
189	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
190	    emit(Fd, "    return oe_error_code;\n  }\n");
191	ParamTK ->
192	    case is_variable_size(ParamTK) of
193		true ->
194		    if is_tuple(ParamTK) ->
195			    case element(1,ParamTK) of
196				tk_array ->
197				    %% Array of dynamic data
198				    emit(Fd,
199					 "  if ((oe_error_code = "
200					 "~s~s(oe_env, ~s)) < 0) {\n",
201					 [ic_util:mk_oe_name(G,
202							     "encode_"),
203					  T, LName]),
204				    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
205				    emit(Fd,
206					 "    return "
207					 "oe_error_code;\n  }\n");
208				_ ->
209				    emit(Fd,
210					 "  if ((oe_error_code = "
211					 "~s~s(oe_env, ~s)) < 0) {\n",
212					 [ic_util:mk_oe_name(G,
213							     "encode_"),
214					  T, LName]),
215				    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
216				    emit(Fd, "    return "
217					 "oe_error_code;\n  }\n")
218			    end;
219		       true ->
220			    emit(Fd,
221				 "  if ((oe_error_code = "
222				 "~s~s(oe_env, ~s)) < 0) {\n",
223				 [ic_util:mk_oe_name(G, "encode_"),
224				  T, LName]),
225			    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
226			    emit(Fd, "    return oe_error_code;\n  }\n")
227		    end;
228		false ->
229		    if is_atom(ParamTK) ->
230			    case normalize_type(ParamTK) of
231				{basic, Type} ->
232				    emit_encoding_stmt_for_basic_type(G, N, T, Fd,
233								      Type,
234								      LName);
235				_ ->
236				    %% Why only return?
237				    ?emit_c_enc_rpt(Fd, "    ", "~/slist/~s", [T, LName]),
238				    emit(Fd, "    return oe_error_code;\n  }\n"),
239				    ok
240			    end;
241		       true ->
242			    case element(1,ParamTK) of
243				tk_enum ->
244				    emit(Fd, "  if ((oe_error_code = "
245					 "~s~s(oe_env, ~s)) < 0) {\n",
246					 [ic_util:mk_oe_name(G, "encode_"),
247					  T, LName]),
248				    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
249				    emit(Fd, "    return oe_error_code;\n  }\n");
250				tk_array ->
251				    emit(Fd, "  if ((oe_error_code = "
252					 "~s~s(oe_env, ~s)) < 0) {\n",
253					 [ic_util:mk_oe_name(G, "encode_"),
254					  T, LName]),
255				    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
256				    emit(Fd, "    return oe_error_code;\n  }\n");
257				tk_struct ->
258				    emit(Fd, "  if ((oe_error_code = "
259					 "~s~s(oe_env, ~s)) < 0) {\n",
260					 [ic_util:mk_oe_name(G, "encode_"),
261					  T, LName]),
262				    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
263				    emit(Fd, "    return oe_error_code;\n  }\n");
264				tk_union ->
265				    emit(Fd, "  if ((oe_error_code = "
266					 "~s~s(oe_env, ~s)) < 0) {\n",
267					 [ic_util:mk_oe_name(G, "encode_"),
268					  T, LName]),
269				    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
270				    emit(Fd, "    return oe_error_code;\n  }\n");
271				_ ->
272				    emit(Fd, "  if ((oe_error_code = "
273					 "~s~s(oe_env, &~s)) < 0) {\n",
274					 [ic_util:mk_oe_name(G, "encode_"),
275					  T, LName]),
276				    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
277				    emit(Fd, "    return oe_error_code;\n  }\n")
278			    end
279		    end
280	    end
281    end;
282emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer)  when is_record(T, string) ->
283    %% Note prefix: oe_ei
284    emit(Fd, "  if ((oe_error_code = oe_ei_encode_string(oe_env, ~s)) < 0) {\n",
285	 [LName]),
286    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
287    emit(Fd, "    return oe_error_code;\n  }\n");
288emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) when is_record(T, wstring) ->
289    %% Note prefix: oe_ei
290    emit(Fd, "  if ((oe_error_code = "
291	 "oe_ei_encode_wstring(oe_env, ~s)) < 0) {\n",
292	 [LName]),
293    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
294    emit(Fd, "    return oe_error_code;\n  }\n");
295emit_encoding_stmt(G, N, _X, Fd, T, LName, _OutBuffer) ->
296    case normalize_type(T) of
297	{basic, Type} ->
298	    emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName);
299	{void, _} ->
300	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
301	    emit(Fd, "    return oe_error_code;\n  }\n"),
302	    ok;
303	{sequence, _, _} ->
304	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
305	    emit(Fd, "    return oe_error_code;\n  }\n"),
306	    ok;
307	{_ArrayType, {array, _, _}} ->
308	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
309	    emit(Fd, "    return oe_error_code;\n  }\n"),
310	    ok;
311	{struct, _, _, _} -> %% Struct as a member in struct !
312	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
313	    emit(Fd, "    return oe_error_code;\n  }\n"),
314	    ok;
315	_ ->
316	    %%io:format("2 ------------> ~p~n", [T]),
317	    ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
318    end.
319
320%%------------------------------------------------------------
321emit_encoding_stmt_for_basic_type(G, N, T, Fd, Type, LName) ->
322    {Cast, DecType} =
323	case Type of
324 	    ushort ->		{"(unsigned long) ", "ulong"};
325 	    ulong ->		{"", "ulong"};
326 	    ulonglong ->	{"", "ulonglong"};
327 	    short ->		{"(long) ", "long"};
328 	    long ->		{"", "long"};
329 	    longlong ->		{"", "longlong"};
330 	    float ->		{"(double) ", "double"};
331 	    double ->		{"", "double"};
332 	    boolean ->		{"", "atom"};
333 	    char ->		{"", "char"};
334 	    wchar ->		{"", "wchar"};
335 	    octet ->		{"", "char"};
336 	    any ->		{"", "long"}	% Fix for any
337	end,
338    case Type of
339	boolean ->
340	    %% Note prefix: oe_ei
341	    emit(Fd, "  switch(~s) {\n",[LName]),
342	    emit(Fd, "    case 0 :\n"),
343	    emit(Fd, "      if ((oe_error_code = "
344		 "oe_ei_encode_atom(oe_env, "
345		 "\"false\")) < 0) {\n"),
346	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
347	    emit(Fd, "    return oe_error_code;\n    }\n"),
348	    emit(Fd, "      break;\n"),
349	    emit(Fd, "    case 1 :\n"),
350	    emit(Fd, "      if ((oe_error_code = "
351		 "oe_ei_encode_atom(oe_env, "
352		 "\"true\")) < 0) {\n"),
353	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
354	    emit(Fd, "    return oe_error_code;\n    }\n"),
355	    emit(Fd, "      break;\n"),
356	    emit(Fd, "    default :\n"),
357	    emit(Fd, "      return -1;\n"),
358	    emit(Fd, "  }\n\n");
359	_ ->
360	    Fmt =
361		"  if ((oe_error_code = oe_ei_encode_~s(oe_env, ~s~s)) < 0) {\n",
362	    emit(Fd, Fmt, [DecType, Cast, LName]),
363	    ?emit_c_enc_rpt(Fd, "    ", "~s", [LName]),
364	    emit(Fd, "    return oe_error_code;\n  }\n")
365    end.
366
367
368%%------------------------------------------------------------
369%% MALLOC SIZE (for Decode)
370%%------------------------------------------------------------
371
372emit_malloc_size_stmt(G, N, Fd, T, InBuffer,
373		      Align, CalcType) when element(1, T) == scoped_id ->
374    case mk_c_type(G, N, T, evaluate_not) of
375	"erlang_pid" ->
376	    emit(Fd, "  oe_malloc_size += sizeof(erlang_pid);\n\n"),
377	    emit(Fd, "  if ((oe_error_code = ei_decode_pid(~s, "
378		 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
379	    ?emit_c_dec_rpt(Fd, "    ", "erlang_pid", []),
380	    emit(Fd, "    return oe_error_code;\n  }\n");
381	"erlang_port" ->
382	    emit(Fd, "  oe_malloc_size += sizeof(erlang_port);\n\n"),
383	    emit(Fd, "  if ((oe_error_code = ei_decode_port(~s, "
384		 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
385	    ?emit_c_dec_rpt(Fd, "    ", "erlang_port", []),
386	    emit(Fd, "    return oe_error_code;\n  }\n");
387	"erlang_ref" ->
388	    emit(Fd, "  oe_malloc_size += sizeof(erlang_ref);\n\n"),
389	    emit(Fd, "  if ((oe_error_code = ei_decode_ref(~s, "
390		 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
391	    ?emit_c_dec_rpt(Fd, "    ", "erlang_ref", []),
392	    emit(Fd, "    return oe_error_code;\n  }\n");
393	"ic_erlang_term*" ->
394	    emit(Fd, "  oe_malloc_size += sizeof(char*);\n\n"),
395	    emit(Fd, "  if ((oe_error_code = ic_decode_term(~s, "
396		 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]),
397	    ?emit_c_dec_rpt(Fd, "    ", "ic_erlang_term*", []),
398	    emit(Fd, "    return oe_error_code;\n  }\n");
399	{enum, FSN} ->
400	    emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType);
401	FSN ->
402	    %% io:format("emit_malloc_size_stmt: ~p ~p~n",[FSN,
403	    %% CalcType]),
404	    emit_malloc_size_stmt(G, N, Fd, FSN, InBuffer, Align, CalcType)
405    end;
406
407%% XXX T is a string
408emit_malloc_size_stmt(G, N, Fd, T, InBuffer,
409		      _Align, CalcType)  when is_list(T) ->
410    %% Already a fullscoped name
411    Type = ictype:name2type(G,T),
412    case ictype:isBasicType(Type) of
413	true ->
414	    emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer);
415	false ->
416	    case CalcType of
417		generator ->
418		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
419			 "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
420			 [ic_util:mk_oe_name(G, "sizecalc_"), T]),
421		    ?emit_c_dec_rpt(Fd, "    ", "~s", [T]),
422		    emit(Fd, "    return oe_error_code;\n    }\n");
423		_ ->
424		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
425			 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
426			 [ic_util:mk_oe_name(G, "sizecalc_"), T]),
427		    ?emit_c_dec_rpt(Fd, "    ", "~s", [T]),
428		    emit(Fd, "    return oe_error_code;\n    }\n")
429	    end
430    end;
431emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align,
432		      CalcType) when is_record(T, string) ->
433    Tname = mk_variable_name(op_variable_count),
434    store_tmp_decl("    int ~s = 0;\n",[Tname]),
435    case CalcType of
436	generator ->
437	    emit(Fd, "    if ((oe_error_code = ei_get_type(~s, "
438		 "oe_size_count_index, &oe_type, &~s)) < 0) {\n",
439		 [InBuffer, Tname]);
440	_ ->
441	    emit(Fd, "    int oe_type = 0;\n"),
442	    emit(Fd, "    int oe_temp = 0;\n\n"),
443	    emit(Fd, "    if ((oe_error_code = ei_get_type(~s, "
444		 "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n",
445		 [InBuffer])
446    end,
447    ?emit_c_dec_rpt(Fd, "      ", "ei_get_type", []),
448    emit(Fd, "      return oe_error_code;\n    }\n"),
449    if
450	T#string.length == 0 ->
451	    ok;
452	true ->
453	    Length = ic_util:eval_c(G, N, T#string.length),
454	    case CalcType of
455		generator ->
456		    emit(Fd, "  if (~s > ~s)\n",[Tname, Length]),
457		    emit(Fd, "    return -1;\n\n");
458		_ ->
459		    emit(Fd, "  if (oe_temp > ~s)\n",[Length]),
460		    emit(Fd, "    return -1;\n\n")
461	    end
462    end,
463    case CalcType of
464	generator ->
465	    emit(Fd, "    if ((oe_error_code = ei_decode_string(~s, "
466		 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]);
467	_ ->
468	    emit(Fd, "    if ((oe_error_code = ei_decode_string(~s, "
469		 "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer])
470    end,
471    ?emit_c_dec_rpt(Fd, "      ", "ei_decode_string", []),
472    emit(Fd, "      return oe_error_code;\n    }\n"),
473    case CalcType of
474	generator ->
475	    emit(Fd, "    oe_malloc_size = ~s;\n\n",
476		 [ic_util:mk_align("oe_malloc_size + " ++ Tname ++"+1")]);
477	_ ->
478	    emit(Fd, "    oe_malloc_size = ~s;\n\n",
479		 [ic_util:mk_align("oe_malloc_size + oe_temp+1")])
480    end;
481emit_malloc_size_stmt(G, N, Fd, T, InBuffer, _Align,
482		      CalcType) when is_record(T, wstring) ->
483    Tname = mk_variable_name(op_variable_count),
484    store_tmp_decl("    int ~s = 0;\n",[Tname]),
485    case CalcType of
486	generator ->
487	    emit(Fd, "    if ((oe_error_code = ei_get_type(~s, "
488		 "oe_size_count_index, &oe_type, &~s)) < 0) {\n",
489		 [InBuffer, Tname]);
490	_ ->
491	    emit(Fd, "    int oe_type = 0;\n"),
492	    emit(Fd, "    int oe_temp = 0;\n\n"),
493	    emit(Fd, "    if ((oe_error_code = ei_get_type(~s, "
494		 "&oe_size_count_index, &oe_type, &oe_temp)) < 0) {\n",
495		 [InBuffer])
496    end,
497    ?emit_c_dec_rpt(Fd, "    ", "ei_get_type", []),
498    emit(Fd, "    return oe_error_code;\n    }\n"),
499    if
500	T#wstring.length == 0 ->
501	    ok;
502	true ->
503	    Length = ic_util:eval_c(G, N, T#wstring.length),
504	    case CalcType of
505		generator ->
506		    emit(Fd, "  if (~s > ~s)\n",[Tname, Length]),
507		    emit(Fd, "    return -1;\n\n");
508		_ ->
509		    emit(Fd, "  if (oe_temp > ~s)\n",[Length]),
510		    emit(Fd, "    return -1;\n\n")
511	    end
512    end,
513    case CalcType of
514	generator ->
515	    %% Note prefix: oe_ei
516	    emit(Fd, "    if ((oe_error_code = oe_ei_decode_wstring(~s, "
517		 "oe_size_count_index, NULL)) < 0) {\n", [InBuffer]);
518	_ ->
519	    %% Note prefix: oe_ei
520	    emit(Fd, "    if ((oe_error_code = oe_ei_decode_wstring(~s, "
521		 "&oe_size_count_index, NULL)) < 0) {\n", [InBuffer])
522    end,
523    ?emit_c_dec_rpt(Fd, "    ", "oe_ei_decode_wstring", []),
524    emit(Fd, "    return oe_error_code;\n    }\n"),
525    case CalcType of
526	generator ->
527	    emit(Fd, "    oe_malloc_size =\n      ~s;\n\n",
528		 [ic_util:mk_align("oe_malloc_size + (("
529				   ++ Tname
530				   ++"+ 1) * __OE_WCHAR_SIZE_OF__)")]);
531	_ ->
532	    emit(Fd, "    oe_malloc_size =\n      ~s;\n\n",
533		 [ic_util:mk_align("oe_malloc_size + (("
534				   "oe_temp + 1) * __OE_WCHAR_SIZE_OF__)")])
535    end;
536emit_malloc_size_stmt(G, N, Fd, T, InBuffer, Align, CalcType) ->
537    case Align of
538	0 ->
539	    emit(Fd, "  oe_malloc_size += sizeof(~s);\n\n",
540		 [mk_c_type(G, N, T)]);
541	_ ->
542	    ok
543    end,
544    case normalize_type(T) of
545	{basic, Type} ->
546	    emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer);
547	{void, _} ->
548	    ok;
549	{sequence, _, _} ->
550	    ok;
551	{_, {array, SId, _}} ->
552	    case CalcType of
553		generator ->
554		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
555			 "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
556			 [ic_util:mk_oe_name(G, "sizecalc_"),
557			  ic_forms:get_id2(SId)]),
558		    ?emit_c_dec_rpt(Fd, "    ", "array1", []),
559		    emit(Fd, "    return oe_error_code;\n\n");
560		_ ->
561		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
562			 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
563			 [ic_util:mk_oe_name(G, "sizecalc_"),
564			  ic_forms:get_id2(SId)]),
565		    ?emit_c_dec_rpt(Fd, "    ", "array2", []),
566		    emit(Fd, "    return oe_error_code;\n\n")
567	    end;
568	{union, UId, _, _, _} ->
569	    case CalcType of
570		generator ->
571		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
572			 "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
573			 [ic_util:mk_oe_name(G, "sizecalc_"),
574			  ic_forms:get_id2(UId)]),
575		    ?emit_c_dec_rpt(Fd, "    ", "union1", []),
576		    emit(Fd, "    return oe_error_code;\n\n");
577		_ ->
578		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
579			 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
580			 [ic_util:mk_oe_name(G, "sizecalc_"),
581			  ic_forms:get_id2(UId)]),
582		    ?emit_c_dec_rpt(Fd, "    ", "union2", []),
583		    emit(Fd, "    return oe_error_code;\n\n")
584	    end;
585	{struct, UId, _, _} -> %% Struct as a member in struct !
586	    case CalcType of
587		generator ->
588		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
589			 "oe_size_count_index, &oe_malloc_size)) < 0) {\n",
590			 [ic_util:mk_oe_name(G, "sizecalc_"),
591			  ic_forms:get_id2(UId)]),
592		    ?emit_c_dec_rpt(Fd, "    ", "struct1", []),
593		    emit(Fd, "    return oe_error_code;\n\n");
594		_ ->
595		    emit(Fd, "    if ((oe_error_code = ~s~s(oe_env, "
596			 "&oe_size_count_index, &oe_malloc_size)) < 0) {\n",
597			 [ic_util:mk_oe_name(G, "sizecalc_"),
598			  ic_forms:get_id2(UId)]),
599		    ?emit_c_dec_rpt(Fd, "    ", "struct2", []),
600		    emit(Fd, "    return oe_error_code;\n\n")
601	    end;
602	{any, _} ->   %% Fix for any type
603	    emit(Fd, "    if ((oe_error_code = ei_decode_long(~s, "
604		 "oe_size_count_index, NULL)) < 0) {\n",
605		 [InBuffer]),
606	    ?emit_c_dec_rpt(Fd, "    ", "any", []),
607	    emit(Fd, "    return oe_error_code;\n    }\n");
608	_ ->
609	    ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
610    end.
611
612%%------------------------------------------------------------
613
614emit_malloc_size_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer) ->
615    {Pre, DecType} =
616	case Type of
617	    ushort ->		{"", "ulong"};
618	    ulong ->		{"", "ulong"};
619	    ulonglong ->	{"oe_", "ulonglong"};
620	    short ->		{"", "long"};
621	    long ->		{"", "long"};
622	    longlong ->		{"oe_", "longlong"};
623	    float ->		{"", "double"};
624	    double ->		{"", "double"};
625	    boolean ->		{"", "atom"};
626	    char ->		{"", "char"};
627	    wchar ->		{"oe_", "wchar"};
628	    octet ->		{"", "char"};
629	    any ->		{"", "long"}
630	end,
631    Fmt =
632	"    if ((oe_error_code = ~sei_decode_~s(~s, oe_size_count_index, "
633	"NULL)) < 0) {\n",
634    emit(Fd, Fmt, [Pre, DecType, InBuffer]),
635    ?emit_c_dec_rpt(Fd, "      ", "~s", [DecType]),
636    emit(Fd, "      return oe_error_code;\n    }\n").
637
638%%------------------------------------------------------------
639%%    DECODING
640%%------------------------------------------------------------
641
642emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align,
643		   NextPos, DecType) ->
644    emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align,
645		       NextPos, DecType, []).
646
647emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, Align, NextPos,
648		   DecType, AllocedPars) when element(1, T) == scoped_id ->
649    Fmt =
650	"  if ((oe_error_code = ei_decode_~s(~s, &oe_env->_iin, ~s~s)) < 0)"
651	" {\n",
652    Emit = fun("term") ->
653		   emit(Fd, "  if ((oe_error_code = ic_decode_term(~s, &oe_env->_iin, ~s~s)) < 0) {\n",
654			[InBuffer, IndOp, LName]),
655		   emit_dealloc_stmts(Fd, "    ", AllocedPars),
656		   ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
657		   emit(Fd, "    return oe_error_code;\n"),
658		   emit(Fd, "  }\n");
659	      (Type) ->
660		   emit(Fd, Fmt, [Type, InBuffer, IndOp, LName]),
661		   emit_dealloc_stmts(Fd, "    ", AllocedPars),
662		   ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
663		   emit(Fd, "    return oe_error_code;\n"),
664		   emit(Fd, "  }\n")
665	   end,
666    case mk_c_type(G, N, T, evaluate_not) of
667	"erlang_pid" ->
668	    Emit("pid");
669	"erlang_port" ->
670	    Emit("port");
671	"erlang_ref" ->
672	    Emit("ref");
673	"ic_erlang_term*" ->
674	    Emit("term");
675	{enum, FSN} ->
676	    emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer,
677			       Align, NextPos, DecType, AllocedPars);
678	FSN ->
679	    emit_decoding_stmt(G, N, Fd, FSN, LName, IndOp, InBuffer,
680			       Align, NextPos, DecType, AllocedPars)
681    end;
682
683%% XXX T is a string
684emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos,
685		   DecType, AllocedPars)  when is_list(T) ->
686    %% Already a fullscoped name
687    Type = ictype:name2type(G,T),
688    case ictype:isBasicType(Type) of
689	true ->
690	    emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp,
691					      LName, AllocedPars);
692	false ->
693	    case DecType of
694		generator ->
695		    emit(Fd, "  if ((oe_error_code = ~s~s(oe_env, oe_first, "
696			 "~s, ~s)) < 0) {\n",
697			 [ic_util:mk_oe_name(G, "decode_"),
698			  T, NextPos, LName]),
699		    emit_dealloc_stmts(Fd, "    ", AllocedPars),
700		    ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
701		    emit(Fd, "    return oe_error_code;\n"),
702		    emit(Fd, "  }\n");
703		caller -> %% No malloc used, define oe_first
704		    emit(Fd, "    {\n"),
705		    emit(Fd, "      void *oe_first = NULL;\n"),
706		    emit(Fd, "      int oe_outindex = 0;\n\n"),
707		    emit(Fd, "      if ((oe_error_code = ~s~s(oe_env, "
708			 "oe_first, ~s, ~s)) < 0) {\n",
709			 [ic_util:mk_oe_name(G, "decode_"),
710			  T, NextPos, LName]),
711		    emit_dealloc_stmts(Fd, "      ", AllocedPars),
712		    ?emit_c_dec_rpt(Fd, "         ", "~s", [LName]),
713		    emit(Fd, "        return oe_error_code;\n"),
714		    emit(Fd, "      }\n"),
715		    emit(Fd, "    }\n");
716		caller_dyn ->  %% Malloc used
717		    emit(Fd, "    {\n"),
718		    emit(Fd, "      int oe_outindex = 0;\n\n"),
719		    emit(Fd, "      if ((oe_error_code = ~s~s(oe_env, "
720			 "oe_first, ~s, ~s)) < 0) {\n",
721			 [ic_util:mk_oe_name(G, "decode_"),
722			  T, NextPos, LName]),
723		    emit_dealloc_stmts(Fd, "        ", AllocedPars),
724		    ?emit_c_dec_rpt(Fd, "        ", "~s", [LName]),
725		    emit(Fd, "        return oe_error_code;\n"),
726		    emit(Fd, "      }\n"),
727		    emit(Fd, "    }\n");
728		array_dyn ->  %% Malloc used
729		    emit(Fd, "    {\n"),
730		    emit(Fd, "      int oe_outindex = 0;\n\n"),
731		    emit(Fd, "      if ((oe_error_code = ~s~s(oe_env, "
732			 "oe_first, ~s, ~s)) < 0) {\n",
733			 [ic_util:mk_oe_name(G, "decode_"),
734			  T, NextPos, LName]),
735		    emit_dealloc_stmts(Fd, "    ", AllocedPars),
736		    ?emit_c_dec_rpt(Fd, "        ", "~s", [LName]),
737		    emit(Fd, "        return oe_error_code;\n"),
738		    emit(Fd, "      }\n"),
739		    emit(Fd, "    }\n");
740		array_fix_ret ->
741		    emit(Fd, "    {\n"),
742		    emit(Fd, "      int oe_outindex = 0;\n\n"),
743		    emit(Fd, "      if ((oe_error_code = ~s~s(oe_env, "
744			 "oe_first, ~s,*~s)) < 0) {\n",
745			 [ic_util:mk_oe_name(G, "decode_"),
746			  T, NextPos, LName]),
747		    emit_dealloc_stmts(Fd, "        ", AllocedPars),
748		    ?emit_c_dec_rpt(Fd, "         ", "~s", [LName]),
749		    emit(Fd, "        return oe_error_code;\n"),
750		    emit(Fd, "      }\n"),
751		    emit(Fd, "    }\n");
752		array_fix_out -> %% No malloc used, define oe_first
753		    emit(Fd, "    {\n"),
754		    emit(Fd, "      void *oe_first = NULL;\n"),
755		    emit(Fd, "      int oe_outindex = 0;\n\n"),
756		    emit(Fd, "      if ((oe_error_code = ~s~s(oe_env, "
757			 "oe_first, ~s, ~s)) < 0) {\n",
758			 [ic_util:mk_oe_name(G, "decode_"),
759			  T, NextPos, LName]),
760		    emit_dealloc_stmts(Fd, "        ", AllocedPars),
761		    ?emit_c_dec_rpt(Fd, "        ", "~s", [LName]),
762		    emit(Fd, "        return oe_error_code;\n"),
763		    emit(Fd, "      }\n"),
764		    emit(Fd, "    }\n")
765	    end
766    end;
767emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
768		   DecType, AllocedPars)  when is_record(T, string) ->
769    case DecType of
770	caller_dyn ->
771	    emit(Fd, "  if ((oe_error_code = ei_decode_string(~s, "
772		 "&oe_env->_iin, ~s~s)) < 0) {\n",
773		 [InBuffer, IndOp, LName]),
774	    emit_dealloc_stmts(Fd, "    ", AllocedPars),
775	    ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
776	    emit(Fd, "    return oe_error_code;\n"),
777	    emit(Fd, "  }\n");
778	_ ->
779	    emit(Fd, "  ~s~s = oe_first + *oe_outindex;\n\n",
780		 [IndOp, LName]),
781	    emit(Fd, "  {\n"),
782	    emit(Fd, "    int oe_type=0;\n"),
783	    emit(Fd, "    int oe_string_ctr=0;\n\n"),
784
785	    emit(Fd, "    (int) ei_get_type(~s, "
786		 "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n",
787		 [InBuffer]),
788
789	    emit(Fd, "    if ((oe_error_code = ei_decode_string(~s, "
790		 "&oe_env->_iin, ~s~s)) < 0) {\n",
791		 [InBuffer, IndOp, LName]),
792	    emit_dealloc_stmts(Fd, "      ", AllocedPars),
793	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
794	    emit(Fd, "      return oe_error_code;\n"),
795	    emit(Fd, "    }\n"),
796	    emit(Fd, "  *oe_outindex = ~s;\n",
797		 [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]),
798	    emit(Fd, "  }\n\n")
799    end;
800emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, _NextPos,
801		   DecType, AllocedPars)  when is_record(T, wstring) ->
802    case DecType of
803	caller_dyn ->
804	    %% Note prefix: oe_ei
805	    emit(Fd, "  if ((oe_error_code = oe_ei_decode_wstring(~s, "
806		 "&oe_env->_iin, ~s~s)) < 0) {\n",
807		 [InBuffer, IndOp, LName]),
808	    emit_dealloc_stmts(Fd, "    ", AllocedPars),
809	    ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
810	    emit(Fd, "    return oe_error_code;\n"),
811	    emit(Fd, "  }/* --- */\n");		% XXX
812	_ ->
813	    emit(Fd, "  ~s~s = oe_first + *oe_outindex;\n\n",
814		 [IndOp, LName]),
815
816	    emit(Fd, "  {\n"),
817	    emit(Fd, "    int oe_type=0;\n"),
818	    emit(Fd, "    int oe_string_ctr=0;\n\n"),
819	    emit(Fd, "    (int) ei_get_type(~s, "
820		 "&oe_env->_iin, &oe_type, &oe_string_ctr);\n\n",
821		 [InBuffer]),
822	    %% Note prefix: oe_ei
823	    emit(Fd, "    if ((oe_error_code = oe_ei_decode_wstring(~s, "
824		 "&oe_env->_iin, ~s~s)) < 0) {\n",
825		 [InBuffer, IndOp, LName]),
826	    emit_dealloc_stmts(Fd, "      ", AllocedPars),
827	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
828	    emit(Fd, "      return oe_error_code;\n"),
829	    emit(Fd, "    }\n"),
830	    emit(Fd, "  *oe_outindex = ~s;\n",
831		 [ic_util:mk_align("*oe_outindex+oe_string_ctr+1")]),
832	    emit(Fd, "  }\n")
833    end;
834emit_decoding_stmt(G, N, Fd, T, LName, IndOp, InBuffer, _Align, NextPos,
835		   _DecType, AllocedPars) ->
836    case normalize_type(T) of
837	{basic, Type} ->
838	    emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp,
839					      LName, AllocedPars);
840	{void, _} ->
841	    emit(Fd, "  if ((oe_error_code = ei_decode_atom(~s, "
842		 "&oe_env->_iin, NULL)) < 0) {\n",
843		 [InBuffer]),
844	    emit_dealloc_stmts(Fd, "    ", AllocedPars),
845	    ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
846	    emit(Fd, "    return oe_error_code;\n"),
847	    emit(Fd, "  }\n");
848	{sequence, _, _} ->
849	    ok;
850	{_, {array, SId, Dims}} ->
851	    AName = ic_forms:get_id2({array, SId, Dims}),
852	    Ptr = "oe_out->"++AName,
853	    emit(Fd, "  if ((oe_error_code = ~s~s(oe_env, "
854		 "oe_first, ~s, ~s)) < 0) {\n",
855		 [ic_util:mk_oe_name(G, "decode_"),
856		  ic_forms:get_id2(SId),
857		  NextPos, Ptr]),
858	    emit_dealloc_stmts(Fd, "    ", AllocedPars),
859	    ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
860	    emit(Fd, "    return oe_error_code;\n"),
861	    emit(Fd, "  }\n");
862	{struct, _, _, _} -> %% Struct as a member in struct !
863	    ok;
864	_ ->
865	    %%io:format("3 ------------> ~p~n", [T]),
866	    ic_error:fatal_error(G, {illegal_typecode_for_c, T, N})
867    end.
868
869%% XXX DecType used in two senses in this file.
870emit_decoding_stmt_for_basic_type(G, N, T, Fd, Type, InBuffer, IndOp,
871				  LName, AllocedPars) ->
872    Fmt =
873	"  if ((oe_error_code = ~sei_decode_~s(~s, &oe_env->_iin, "
874	"~s~s)) < 0) {\n",
875    Ret =
876	"    return oe_error_code;\n"
877	"}\n",
878
879    {Pre, DecType} =
880	case Type of
881	    ushort ->		{"", "ulong"};
882	    ulong ->		{"", "ulong"};
883	    ulonglong ->	{"oe_", "ulonglong"};
884	    short ->		{"", "long"};
885	    long ->		{"", "long"};
886	    longlong ->		{"oe_", "longlong"};
887	    float ->		{"", "double"};
888	    double ->		{"", "double"};
889	    boolean ->		{"", "atom"};
890	    char ->		{"", "char"};
891	    wchar ->		{"oe_", "wchar"};
892	    octet ->		{"", "char"};
893	    any ->		{"", "long"}
894	end,
895    case Type of
896	ushort ->
897	    emit(Fd, "  {\n"),
898	    emit(Fd, "    unsigned long oe_ulong;\n"),
899	    emit(Fd, "    if ((oe_error_code = ei_decode_ulong(~s, "
900		 "&oe_env->_iin, &oe_ulong)) < 0) {\n",
901		 [InBuffer]),
902	    emit_dealloc_stmts(Fd, "    ", AllocedPars),
903	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
904	    emit(Fd, "      return oe_error_code;\n"),
905	    emit(Fd, "}\n"),
906	    emit(Fd, "    *(~s) = (unsigned short) oe_ulong;\n\n",
907		 [LName]),
908	    emit(Fd, "    if (*(~s) !=  oe_ulong){\n",
909		 [LName]),
910	    emit_dealloc_stmts(Fd, "      ", AllocedPars),
911	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
912	    emit(Fd, "      return -1;\n"),
913	    emit(Fd, "    }\n"),
914	    emit(Fd, "  }\n\n");
915	short ->
916	    emit(Fd, "  {\n"),
917	    emit(Fd, "    long oe_long;\n"),
918	    emit(Fd, "    if ((oe_error_code = ei_decode_long(~s, "
919		 "&oe_env->_iin, &oe_long)) < 0){\n",
920		 [InBuffer]),
921	    emit_dealloc_stmts(Fd, "    ", AllocedPars),
922	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
923	    emit(Fd, "      return oe_error_code;\n\n"),
924	    emit(Fd, "}\n"),
925	    emit(Fd, "    *(~s) = (short) oe_long;\n\n",[LName]),
926	    emit(Fd, "    if (*(~s) !=  oe_long){\n", [LName]),
927	    emit_dealloc_stmts(Fd, "      ", AllocedPars),
928	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
929	    emit(Fd, "      return -1;\n"),
930	    emit(Fd, "    }\n"),
931	    emit(Fd, "  }\n");
932	float ->
933	    emit(Fd, "  {\n"),
934	    emit(Fd, "    double oe_double;\n"),
935	    emit(Fd, "    if ((oe_error_code = ei_decode_double(~s, "
936		 "&oe_env->_iin, &oe_double)) < 0){\n",
937		 [InBuffer]),
938	    emit_dealloc_stmts(Fd, "      ", AllocedPars),
939	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
940	    emit(Fd, "      return oe_error_code;\n\n"),
941	    emit(Fd,      "}\n"),
942	    emit(Fd, "    *(~s) = (float) oe_double;\n",[LName]),
943	    emit(Fd, "  }\n");
944	boolean ->
945	    emit(Fd, "  {\n"),
946	    emit(Fd, "    char oe_bool[25];\n\n"),
947	    emit(Fd, "    if ((oe_error_code = ei_decode_atom(~s, "
948		 "&oe_env->_iin, oe_bool)) < 0){\n",[InBuffer]),
949	    emit_dealloc_stmts(Fd, "      ", AllocedPars),
950	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
951	    emit(Fd, "      return oe_error_code;\n"),
952	    emit(Fd,      "}\n"),
953	    emit(Fd, "    if (strcmp(oe_bool, \"false\") == 0) {\n"),
954	    emit(Fd, "      *(~s) = 0;\n",[LName]),
955	    emit(Fd, "    }\n"),
956	    emit(Fd, "    else if (strcmp(oe_bool, \"true\") == 0)"
957		 " {\n"),
958	    emit(Fd, "      *(~s) = 1;\n",[LName]),
959	    emit(Fd, "    }\n"),
960	    emit(Fd, "    else {\n"),
961	    emit_dealloc_stmts(Fd, "      ", AllocedPars),
962	    ?emit_c_dec_rpt(Fd, "      ", "~s", [LName]),
963	    emit(Fd, "      return -1;\n"),
964	    emit(Fd, "    }\n"),
965	    emit(Fd, "  }\n");
966	_ ->
967	    emit(Fd, Fmt, [Pre, DecType, InBuffer, IndOp, LName]),
968	    ?emit_c_dec_rpt(Fd, "    ", "~s", [LName]),
969	    emit_dealloc_stmts(Fd, "    ", AllocedPars),
970	    emit(Fd, Ret)
971    end.
972
973%%------------------------------------------------------------
974%%
975%%------------------------------------------------------------
976emit_dealloc_stmts(Fd, Prefix, AllocedPars) ->
977    Fmt = Prefix ++ "CORBA_free(~s);\n",
978    lists:foreach(
979      fun(Par) -> emit(Fd, Fmt, [Par]) end,
980      AllocedPars).
981
982
983%%------------------------------------------------------------
984%%
985%%------------------------------------------------------------
986
987mk_variable_name(Var) ->
988    Nr = get(Var),
989    put(Var, Nr + 1),
990    "oe_tmp" ++ integer_to_list(Nr).
991
992%%    IDL to C type conversion
993%%------------------------------------------------------------
994mk_c_type(G, N, S) ->
995    mk_c_type(G, N, S, evaluate).
996
997mk_c_type(G, N, S, evaluate) when element(1, S) == scoped_id ->
998    {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
999    BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
1000    case BT of
1001	"erlang_binary" ->
1002	    "erlang_binary";
1003	"erlang_pid" ->
1004	    "erlang_pid";
1005	"erlang_port" ->
1006	    "erlang_port";
1007	"erlang_ref" ->
1008	    "erlang_ref";
1009	"erlang_term" ->
1010	    "ic_erlang_term*";
1011	{enum, Type} ->
1012	    mk_c_type(G, N, Type, evaluate);
1013	Type ->
1014	    mk_c_type(G, N, Type, evaluate)
1015    end;
1016
1017mk_c_type(G, N, S, evaluate_not) when element(1, S) == scoped_id ->
1018    {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
1019    BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
1020    case BT of
1021	"erlang_binary" ->
1022	    "erlang_binary";
1023	"erlang_pid" ->
1024	    "erlang_pid";
1025	"erlang_port" ->
1026	    "erlang_port";
1027	"erlang_ref" ->
1028	    "erlang_ref";
1029	"erlang_term" ->
1030	    "ic_erlang_term*";
1031	Type ->
1032	    Type
1033    end;
1034mk_c_type(_G, _N, S, _) when is_list(S) ->
1035    S;
1036mk_c_type(_G, _N, S, _) when is_record(S, string) ->
1037    "CORBA_char *";
1038mk_c_type(_G, _N, S, _) when is_record(S, wstring) ->
1039    "CORBA_wchar *";
1040mk_c_type(_G, _N, {boolean, _}, _) ->
1041    "CORBA_boolean";
1042mk_c_type(_G, _N, {octet, _}, _) ->
1043    "CORBA_octet";
1044mk_c_type(_G, _N, {void, _}, _) ->
1045    "void";
1046mk_c_type(_G, _N, {unsigned, U}, _) ->
1047    case U of
1048	{short,_} ->
1049	    "CORBA_unsigned_short";
1050	{long,_} ->
1051	    "CORBA_unsigned_long";
1052	{'long long',_} ->
1053	    "CORBA_unsigned_long_long"
1054    end;
1055
1056mk_c_type(_G, _N, {'long long', _}, _) ->
1057    "CORBA_long_long";
1058
1059mk_c_type(_G, _N, S, _) when is_record(S, union)->
1060    ic_forms:get_id2(S);
1061
1062mk_c_type(_G, N, S, _) when is_record(S, struct) -> %% Locally defined member
1063    Fullname = [ic_forms:get_id2(S) | N],
1064    ic_util:to_undersc(Fullname);
1065
1066mk_c_type(_G, _N, {'any', _}, _) ->  %% Fix for any type
1067    "CORBA_long";
1068
1069mk_c_type(_G, _N, {T, _}, _) ->
1070    "CORBA_" ++ atom_to_list(T).
1071
1072%%-------------------------------------------------------------------
1073%%    IDL to C type conversion used by the emit_c_*_rpt macros.
1074%%-------------------------------------------------------------------
1075mk_c_type2(G, N, S) when element(1, S) == scoped_id ->
1076    {FullScopedName, _T, _TK, _} = ic_symtab:get_full_scoped_name(G, N, S),
1077    BT = ic_code:get_basetype(G, ic_util:to_undersc(FullScopedName)),
1078    case BT of
1079	"erlang_binary" ->
1080	    "erlang_binary";
1081	"erlang_pid" ->
1082	    "erlang_pid";
1083	"erlang_port" ->
1084	    "erlang_port";
1085	"erlang_ref" ->
1086	    "erlang_ref";
1087	"erlang_term" ->
1088	    "ic_erlang_term*";
1089	{enum, Type} ->
1090	    mk_c_type2(G, N, Type);
1091	Type ->
1092	    mk_c_type2(G, N, Type)
1093    end;
1094
1095mk_c_type2(_G, _N, S) when is_list(S) ->
1096    S;
1097mk_c_type2(_G, _N, S) when is_record(S, string) ->
1098    "CORBA_char *";
1099mk_c_type2(_G, _N, S) when is_record(S, wstring) ->
1100    "CORBA_wchar *";
1101mk_c_type2(_G, _N, {boolean, _}) ->
1102    "CORBA_boolean";
1103mk_c_type2(_G, _N, {octet, _}) ->
1104    "CORBA_octet";
1105mk_c_type2(_G, _N, {void, _}) ->
1106    "void";
1107mk_c_type2(_G, _N, {unsigned, U}) ->
1108    case U of
1109	{short,_} ->
1110	    "CORBA_unsigned_short";
1111	{long,_} ->
1112	    "CORBA_unsigned_long";
1113	{'long long',_} ->
1114	    "CORBA_unsigned_long_long"
1115    end;
1116
1117mk_c_type2(_G, _N, {'long long', _}) ->
1118    "CORBA_long_long";
1119
1120mk_c_type2(_G, _N, S) when is_record(S, union)->
1121    ic_forms:get_id2(S);
1122
1123mk_c_type2(_G, N, S) when is_record(S, struct) ->
1124    Fullname = [ic_forms:get_id2(S) | N],
1125    ic_util:to_undersc(Fullname);
1126
1127mk_c_type2(_G, _N, S) when is_record(S, sequence) ->
1128    mk_c_type2(_G, _N, S#sequence.type);
1129
1130mk_c_type2(_G, _N, {'any', _}) ->  %% Fix for any type
1131    "CORBA_long";
1132
1133mk_c_type2(_G, _N, {T, _}) ->
1134    "CORBA_" ++ atom_to_list(T).
1135
1136%%-----
1137
1138is_variable_size_rec(Es) ->
1139    lists:any(
1140      fun({_N, T}) -> is_variable_size(T);
1141	 ({_, _N, T}) -> is_variable_size(T)
1142      end, Es).
1143
1144is_variable_size({'tk_struct', _IFRId, "port", _ElementList}) ->
1145    false;
1146is_variable_size({'tk_struct', _IFRId, "pid", _ElementList}) ->
1147    false;
1148is_variable_size({'tk_struct', _IFRId, "ref", _ElementList}) ->
1149    false;
1150is_variable_size({'tk_struct', _IFRId, "term", _ElementList}) ->
1151    false;
1152is_variable_size({'tk_struct', _IFRId, _Name, ElementList}) ->
1153    is_variable_size_rec(ElementList);
1154is_variable_size({'tk_array', ElemTC, _Length}) ->
1155    is_variable_size(ElemTC);
1156is_variable_size({'tk_string', _}) ->
1157    true;
1158is_variable_size({'tk_wstring', _}) ->
1159    true;
1160is_variable_size({'tk_sequence', _ElemTC, _MaxLsextractength}) ->
1161    true;
1162is_variable_size({'tk_union', _IFRId, _Name, _, _, ElementList}) ->
1163    is_variable_size_rec(ElementList);
1164is_variable_size(_Other) ->
1165    false.
1166
1167
1168is_variable_size(_G, _N, T)  when is_record(T, string) ->
1169    true;
1170is_variable_size(_G, _N, T)  when is_record(T, wstring) ->
1171    true;
1172is_variable_size(_G, _N, T)  when is_record(T, sequence) ->
1173    true;
1174is_variable_size(G, N, T)  when is_record(T, union) ->
1175    %%io:format("~n~p = ~p~n",[ic_forms:get_id2(T),ictype:fetchTk(G, N, T)]),
1176    is_variable_size(ictype:fetchTk(G, N, T));
1177is_variable_size(G, N, T)  when is_record(T, struct) ->
1178    is_variable_size(ictype:fetchTk(G, N, T));
1179is_variable_size(G, N, T) when element(1, T) == scoped_id ->
1180    case ic_symtab:get_full_scoped_name(G, N, T) of
1181	{_FullScopedName, _, TK, _} ->
1182	    is_variable_size(TK);
1183	_ ->
1184	    ic_error:fatal_error(G, {name_not_found, T})
1185    end;
1186is_variable_size(_G, _N, _Other) ->
1187    false.
1188
1189%% mk_dim produces
1190mk_dim([Arg | Args]) ->
1191    "[" ++ Arg ++ "]" ++ mk_dim(Args);
1192mk_dim([]) -> [].
1193
1194mk_slice_dim(Args) ->
1195    mk_dim(tl(Args)).
1196
1197
1198emit_tmp_variables(Fd) ->
1199    DeclList = get(tmp_declarations),
1200    emit_tmp_variables(Fd, DeclList),
1201    ok.
1202
1203emit_tmp_variables(Fd, [Decl |Rest]) ->
1204    emit_tmp_variables(Fd, Rest),
1205    emit(Fd, "~s", [Decl]);
1206emit_tmp_variables(_Fd, []) ->
1207    ok.
1208
1209store_tmp_decl(Format, Args) ->
1210    Decl = io_lib:format(Format, Args),
1211    DeclList = get(tmp_declarations),
1212    put(tmp_declarations, [Decl |DeclList]).
1213
1214%%------------------------------------------------------------
1215%%
1216%% Parser utilities
1217%%
1218%% Called from the yecc parser. Expands the identifier list of an
1219%% attribute so that the attribute generator never has to handle
1220%% lists.
1221%%
1222%%------------------------------------------------------------
1223
1224extract_info(_G, N, X) when is_record(X, op) ->
1225    Name	=  ic_util:to_undersc([ic_forms:get_id2(X) | N]),
1226    Args	= X#op.params,
1227    ArgNames	= mk_c_vars(Args),
1228    TypeList	= {ic_forms:get_type(X),
1229		   lists:map(fun(Y) -> ic_forms:get_type(Y) end, Args),
1230		   []
1231		  },
1232    {Name, ArgNames, TypeList};
1233extract_info(_G, N, X) ->
1234    Name	=  ic_util:to_undersc([ic_forms:get_id2(X) | N]),
1235    {Name, [], []}.
1236
1237
1238
1239%% Usefull functions
1240get_param_tk(Name, Op) ->
1241    case get_param(Name, Op) of
1242	error ->
1243	    error;
1244	Param ->
1245	    ic_forms:get_tk(Param)
1246    end.
1247
1248get_param(Name, Op) when is_record(Op, op) ->
1249    get_param_loop(Name, Op#op.params);
1250get_param(_Name, _Op) ->
1251    error.
1252
1253get_param_loop(Name,[Param|Params]) ->
1254    case ic_forms:get_id2(Param) of
1255	Name ->
1256	    Param;
1257	_ ->
1258	    get_param_loop(Name,Params)
1259    end;
1260get_param_loop(_Name, []) ->
1261    error.
1262
1263
1264%% Input is a list of parameters (in parse form) and output is a list
1265%% of parameter attribute and variable names.
1266mk_c_vars(Params) ->
1267    lists:map(fun(P) -> {A, _} = P#param.inout,
1268			{A, ic_forms:get_id(P#param.id)}
1269	      end,
1270	      Params).
1271
1272normalize_type({unsigned, {short, _}}) ->	{basic, ushort};
1273normalize_type({unsigned, {long, _}}) -> 	{basic, ulong};
1274normalize_type({unsigned, {'long long', _}}) ->	{basic, ulonglong};
1275normalize_type({short,_}) ->			{basic, short};
1276normalize_type({long, _}) ->			{basic, long};
1277normalize_type({'long long', _}) ->		{basic, longlong};
1278normalize_type({float,_}) ->			{basic, float};
1279normalize_type({double, _}) ->			{basic, double};
1280normalize_type({boolean, _}) ->			{basic, boolean};
1281normalize_type({char, _}) ->			{basic, char};
1282normalize_type({wchar, _}) ->			{basic, wchar};
1283normalize_type({octet, _}) ->			{basic, octet};
1284normalize_type({any, _}) ->			{basic, any};
1285normalize_type(tk_ushort) -> 			{basic, ushort};
1286normalize_type(tk_ulong) -> 			{basic, ulong};
1287normalize_type(tk_ulonglong) -> 		{basic, ulonglong};
1288normalize_type(tk_short) -> 			{basic, short};
1289normalize_type(tk_long) -> 			{basic, long};
1290normalize_type(tk_longlong) -> 			{basic, longlong};
1291normalize_type(tk_float) -> 			{basic, float};
1292normalize_type(tk_double) -> 			{basic, double};
1293normalize_type(tk_boolean) -> 			{basic, boolean};
1294normalize_type(tk_char) -> 			{basic, char};
1295normalize_type(tk_wchar) -> 			{basic, wchar};
1296normalize_type(tk_octet) -> 			{basic, octet};
1297normalize_type(tk_any) -> 			{basic, any};
1298normalize_type(ushort) -> 			{basic, ushort};
1299normalize_type(ulong) -> 			{basic, ulong};
1300normalize_type(ulonglong) ->	 		{basic, ulonglong};
1301normalize_type(short) -> 			{basic, short};
1302normalize_type(long) -> 			{basic, long};
1303normalize_type(longlong) -> 			{basic, longlong};
1304normalize_type(float) -> 			{basic, float};
1305normalize_type(double) -> 			{basic, double};
1306normalize_type(boolean) -> 			{basic, boolean};
1307normalize_type(char) -> 			{basic, char};
1308normalize_type(wchar) -> 			{basic, wchar};
1309normalize_type(octet) -> 			{basic, octet};
1310normalize_type(any) -> 				{basic, any};
1311normalize_type(Type) ->	Type.
1312
1313