1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-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%%
21-module(asn1ct_gen).
22
23-include("asn1_records.hrl").
24
25-export([emit/1,
26	 open_output_file/1,close_output_file/0,
27	 get_inner/1,type/1,def_to_tag/1,prim_bif/1,
28	 list2name/1,
29	 list2rname/1,
30	 constructed_suffix/2,
31	 unify_if_string/1,
32	 get_constraint/2,
33	 insert_once/2,
34	 ct_gen_module/1,
35	 index2suffix/1,
36	 get_record_name_prefix/1,
37	 conform_value/2,
38	 named_bitstring_value/2,
39         complist_as_tuple/1]).
40-export([pgen/3,
41	 mk_var/1,
42	 un_hyphen_var/1]).
43-export([gen_encode_constructed/4,
44	 gen_decode_constructed/4]).
45
46-define(SUPPRESSION_FUNC, 'dialyzer-suppressions').
47
48
49%% pgen(Outfile, Erules, Module, TypeOrVal, Options)
50%% Generate Erlang module (.erl) and (.hrl) file corresponding to
51%% an ASN.1 module. The .hrl file is only generated if necessary.
52
53-spec pgen(Outfile, Gen, Code) -> 'ok' when
54      Outfile :: any(),
55      Gen :: #gen{},
56      Code :: #abst{}.
57
58pgen(OutFile, #gen{options=Options}=Gen, Code) ->
59    #abst{name=Module,types=Types} = Code,
60    N2nConvEnums = [CName|| {n2n,CName} <- Options],
61    case N2nConvEnums -- Types of
62	[] ->
63	    ok;
64	UnmatchedTypes ->
65	    exit({"Non existing ENUMERATION types used in n2n option",
66		   UnmatchedTypes})
67    end,
68    put(outfile, OutFile),
69    put(currmod, Module),
70    HrlGenerated = pgen_hrl(Gen, Code),
71    asn1ct_name:start(),
72    ErlFile = lists:concat([OutFile,".erl"]),
73    _ = open_output_file(ErlFile),
74    asn1ct_func:start_link(),
75    gen_head(Gen, Module, HrlGenerated),
76    pgen_exports(Gen, Code),
77    pgen_dispatcher(Gen, Types),
78    pgen_info(),
79    pgen_typeorval(Gen, N2nConvEnums, Code),
80    pgen_partial_incomplete_decode(Gen),
81    emit([nl,
82	  "%%%",nl,
83	  "%%% Run-time functions.",nl,
84	  "%%%",nl]),
85    dialyzer_suppressions(Gen),
86    Fd = get(gen_file_out),
87    asn1ct_func:generate(Fd),
88    close_output_file(),
89    _ = erase(outfile),
90    asn1ct:verbose("--~p--~n", [{generated,ErlFile}], Gen),
91    ok.
92
93dialyzer_suppressions(Erules) ->
94    emit([nl,
95	  {asis,?SUPPRESSION_FUNC},"(Arg) ->",nl]),
96    Rtmod = ct_gen_module(Erules),
97    Rtmod:dialyzer_suppressions(Erules).
98
99pgen_typeorval(Erules, N2nConvEnums, Code) ->
100    #abst{name=Module,types=Types,values=Values,
101          objects=Objects,objsets=ObjectSets} = Code,
102    Rtmod = ct_gen_module(Erules),
103    pgen_types(Rtmod,Erules,N2nConvEnums,Module,Types),
104    pgen_values(Values, Module),
105    pgen_objects(Rtmod,Erules,Module,Objects),
106    pgen_objectsets(Rtmod,Erules,Module,ObjectSets),
107    pgen_partial_decode(Rtmod,Erules,Module),
108    %% If the encoding rule is ber, per or uper and jer is also given as option
109    %% then we generate "extra" support for jer in the same file
110    case Erules#gen.jer of
111        true ->
112            NewErules = Erules#gen{erule=jer,jer=false},
113            JER_Rtmod = ct_gen_module(NewErules),
114            pgen_types(JER_Rtmod,Erules#gen{erule=jer,jer=false},[],Module,Types);
115        false ->
116            ok
117    end.
118
119%% Generate a function 'V'/0 for each Value V defined in the ASN.1 module.
120%% The function returns the value in an Erlang representation which can be
121%% used as input to the runtime encode functions.
122
123pgen_values([H|T], Module) ->
124    #valuedef{name=Name,value=Value} = asn1_db:dbget(Module, H),
125    emit([{asis,Name},"() ->",nl,
126          {asis,Value},".",nl,nl]),
127    pgen_values(T, Module);
128pgen_values([], _) ->
129    ok.
130
131pgen_types(_, _, _, _, []) ->
132    true;
133pgen_types(Rtmod,Erules,N2nConvEnums,Module,[H|T]) ->
134    asn1ct_name:clear(),
135    Typedef = asn1_db:dbget(Module,H),
136    Rtmod:gen_encode(Erules,Typedef),
137    asn1ct_name:clear(),
138    Rtmod:gen_decode(Erules,Typedef),
139    case lists:member(H,N2nConvEnums) of
140	true ->
141	    pgen_n2nconversion(Erules,Typedef);
142	_ ->
143	    true
144    end,
145    pgen_types(Rtmod,Erules,N2nConvEnums,Module,T).
146
147%% Enumerated type with extension marker
148pgen_n2nconversion(_Erules,#typedef{name=TypeName,typespec=#type{def={'ENUMERATED',{NN1,NN2}}}}) ->
149    NN = NN1 ++ NN2,
150    pgen_name2numfunc(TypeName,NN, extension_marker),
151    pgen_num2namefunc(TypeName,NN, extension_marker);
152%% Without extension marker
153pgen_n2nconversion(_Erules,#typedef{name=TypeName,typespec=#type{def={'ENUMERATED',NN}}}) ->
154    pgen_name2numfunc(TypeName,NN, no_extension_marker),
155    pgen_num2namefunc(TypeName,NN, no_extension_marker);
156pgen_n2nconversion(_Erules,_) ->
157    true.
158
159pgen_name2numfunc(TypeNameAsAtom,Mapping,Ext) when is_atom(TypeNameAsAtom) ->
160    FuncName = list_to_atom("name2num_"++atom_to_list(TypeNameAsAtom)),
161    pgen_name2numfunc1(FuncName,Mapping,Ext).
162
163pgen_name2numfunc1(_FuncName,[], _) ->
164    true;
165pgen_name2numfunc1(FuncName,[{Atom,Number}], extension_marker) ->
166    emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,";",nl]),
167    emit([{asis,FuncName},"({asn1_enum, Num}) -> Num.",nl,nl]);
168pgen_name2numfunc1(FuncName,[{Atom,Number}], _) ->
169    emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,".",nl,nl]);
170pgen_name2numfunc1(FuncName,[{Atom,Number}|NNRest], EM) ->
171    emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,";",nl]),
172    pgen_name2numfunc1(FuncName,NNRest, EM).
173
174pgen_num2namefunc(TypeNameAsAtom,Mapping,Ext) when is_atom(TypeNameAsAtom) ->
175    FuncName = list_to_atom("num2name_"++atom_to_list(TypeNameAsAtom)),
176    pgen_num2namefunc1(FuncName,Mapping,Ext).
177
178pgen_num2namefunc1(_FuncName,[], _) ->
179    true;
180pgen_num2namefunc1(FuncName,[{Atom,Number}], extension_marker) ->
181    emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},";",nl]),
182    emit([{asis,FuncName},"(ExtensionNum) -> {asn1_enum, ExtensionNum}.",nl,nl]);
183pgen_num2namefunc1(FuncName,[{Atom,Number}], _) ->
184    emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},".",nl,nl]);
185pgen_num2namefunc1(FuncName,[{Atom,Number}|NNRest], EM) ->
186    emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},";",nl]),
187    pgen_num2namefunc1(FuncName,NNRest, EM).
188
189
190
191pgen_objects(_,_,_,[]) ->
192    true;
193pgen_objects(Rtmod,Erules,Module,[H|T]) ->
194    asn1ct_name:clear(),
195    Typedef = asn1_db:dbget(Module,H),
196    Rtmod:gen_obj_code(Erules,Module,Typedef),
197    pgen_objects(Rtmod,Erules,Module,T).
198
199pgen_objectsets(_,_,_,[]) ->
200    true;
201pgen_objectsets(Rtmod,Erules,Module,[H|T]) ->
202    asn1ct_name:clear(),
203    TypeDef = asn1_db:dbget(Module,H),
204    Rtmod:gen_objectset_code(Erules,TypeDef),
205    pgen_objectsets(Rtmod,Erules,Module,T).
206
207pgen_partial_decode(Rtmod, #gen{erule=ber}=Gen, Module) ->
208    pgen_partial_inc_dec(Rtmod, Gen, Module),
209    pgen_partial_dec(Rtmod, Gen, Module);
210pgen_partial_decode(_, _, _) ->
211    ok.
212
213pgen_partial_inc_dec(Rtmod,Erules,Module) ->
214    case asn1ct:get_gen_state_field(inc_type_pattern) of
215	undefined ->
216	    ok;
217	ConfList ->
218	    PatternLists=lists:map(fun({_,P}) -> P end,ConfList),
219	    pgen_partial_inc_dec1(Rtmod,Erules,Module,PatternLists),
220	    gen_partial_inc_dec_refed_funcs(Rtmod,Erules)
221    end.
222
223%% pgen_partial_inc_dec1 generates a function of the toptype in each
224%% of the partial incomplete decoded types.
225pgen_partial_inc_dec1(Rtmod,Erules,Module,[P|Ps]) ->
226    TopTypeName = asn1ct:partial_inc_dec_toptype(P),
227    TypeDef=asn1_db:dbget(Module,TopTypeName),
228    asn1ct_name:clear(),
229    asn1ct:update_gen_state(namelist,P),
230    asn1ct:update_gen_state(active,true),
231    asn1ct:update_gen_state(prefix,"dec-inc-"),
232    case asn1ct:maybe_saved_sindex(TopTypeName,P) of
233	I when is_integer(I),I > 0 ->
234	    asn1ct:set_current_sindex(I);
235	_I ->
236	    asn1ct:set_current_sindex(0),
237	    ok
238    end,
239    Rtmod:gen_decode(Erules,TypeDef),
240    gen_dec_part_inner_constr(Rtmod,Erules,TypeDef,[TopTypeName]),
241    pgen_partial_inc_dec1(Rtmod,Erules,Module,Ps);
242pgen_partial_inc_dec1(_,_,_,[]) ->
243    ok.
244
245gen_partial_inc_dec_refed_funcs(Rtmod, #gen{erule=ber}=Gen) ->
246    case asn1ct:next_refed_func() of
247	[] ->
248	    ok;
249	{#'Externaltypereference'{module=M,type=Name},Sindex,Pattern} ->
250	    TypeDef = asn1_db:dbget(M,Name),
251	    asn1ct:update_gen_state(namelist,Pattern),
252	    asn1ct:set_current_sindex(Sindex),
253	    Rtmod:gen_inc_decode(Gen, TypeDef),
254	    gen_dec_part_inner_constr(Rtmod, Gen, TypeDef, [Name]),
255	    gen_partial_inc_dec_refed_funcs(Rtmod, Gen);
256	{Name,Sindex,Pattern,Type} ->
257	    TypeDef=#typedef{name=asn1ct_gen:list2name(Name),typespec=Type},
258	    asn1ct:update_gen_state(namelist,Pattern),
259	    asn1ct:set_current_sindex(Sindex),
260	    Rtmod:gen_inc_decode(Gen, TypeDef),
261	    gen_dec_part_inner_constr(Rtmod, Gen, TypeDef, Name),
262	    gen_partial_inc_dec_refed_funcs(Rtmod, Gen)
263    end.
264
265pgen_partial_dec(_Rtmod,Erules,_Module) ->
266    Type_pattern = asn1ct:get_gen_state_field(type_pattern),
267    %% Get the typedef of the top type and follow into the choosen
268    %% components until the last type/component.
269    pgen_partial_types(Erules,Type_pattern),
270    ok.
271
272pgen_partial_types(#gen{options=Options}=Gen, TypePattern)  ->
273    %% until this functionality works on all back-ends
274    case lists:member(asn1config, Options) of
275	true ->
276	    pgen_partial_types1(Gen, TypePattern);
277	false ->
278            ok
279    end.
280
281
282pgen_partial_types1(Erules,[{FuncName,[TopType|RestTypes]}|Rest]) ->
283    CurrMod = get(currmod),
284    TypeDef = asn1_db:dbget(CurrMod,TopType),
285    traverse_type_structure(Erules,TypeDef,RestTypes,FuncName,
286			    TypeDef#typedef.name),
287    pgen_partial_types1(Erules,Rest);
288pgen_partial_types1(_,[]) ->
289    ok;
290pgen_partial_types1(_,undefined) ->
291    ok.
292
293%% traverse_type_structure searches the structure of TypeDef for next
294%% type/component in TypeList until the last one. For the last type in
295%% TypeList a decode function will be generated.
296traverse_type_structure(Erules,Type,[],FuncName,TopTypeName) ->
297    %% this is the selected type
298    Ctmod = ct_gen_module(Erules),
299    TypeDef =
300	case Type of
301	    #type{} ->
302		#typedef{name=TopTypeName,typespec=Type};
303	    #typedef{} -> Type
304	end,
305    Ctmod:gen_decode_selected(Erules,TypeDef,FuncName); % what if Type is #type{}
306traverse_type_structure(Erules,#type{def=Def},[[N]],FuncName,TopTypeName)
307  when is_integer(N) ->
308    %% In this case a decode of one of the elements in the SEQUENCE OF is
309    %% required.
310    InnerType = asn1ct_gen:get_inner(Def),
311    case InnerType of
312	'SEQUENCE OF' ->
313	    {_,Type} = Def,
314	    traverse_type_structure(Erules,Type,[],FuncName,TopTypeName);
315	WrongType ->
316	    exit({error,{configuration_file_error,[N],"only for SEQUENCE OF components",WrongType}})
317    end;
318traverse_type_structure(Erules,Type,[[N]|Ts],FuncName,TopTypeName)
319  when is_integer(N)  ->
320    traverse_type_structure(Erules,Type,Ts,FuncName,TopTypeName);
321traverse_type_structure(Erules,#type{def=Def},[T|Ts],FuncName,TopTypeName)  ->
322    InnerType = asn1ct_gen:get_inner(Def),
323    case InnerType of
324	'SET' ->
325	    #'SET'{components=Components} = Def,
326	    C = get_component(T,Components),
327	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
328				    FuncName,[T|TopTypeName]);
329	'SEQUENCE' ->
330	    #'SEQUENCE'{components=Components} = Def,
331	    C = get_component(T,Components),
332	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
333				    FuncName,[T|TopTypeName]);
334	'CHOICE' ->
335	    {_,Components} = Def,
336	    C = get_component(T,Components),
337	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
338				    FuncName,[T|TopTypeName]);
339	'SEQUENCE OF' ->
340	    {_,Type} = Def,
341	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
342				       TopTypeName);
343	'SET OF' ->
344	    {_,Type} = Def,
345	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
346				       TopTypeName);
347	#'Externaltypereference'{module=M,type=TName} ->
348	    TypeDef = asn1_db:dbget(M,TName),
349	    traverse_type_structure(Erules,TypeDef,[T|Ts],FuncName,
350				    [TypeDef#typedef.name]);
351	_ ->
352	    traverse_type_structure(Erules,Def,Ts,FuncName,[T|TopTypeName])
353    end;
354traverse_type_structure(Erules,#typedef{typespec=Def},[T|Ts],FuncName,
355			TopTypeName)  ->
356    InnerType = asn1ct_gen:get_inner(Def#type.def),
357    case InnerType of
358	'SET' ->
359	    #'SET'{components=Components} = Def#type.def,
360	    C = get_component(T,Components),
361	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
362				    FuncName,[T|TopTypeName]);
363	'SEQUENCE' ->
364	    #'SEQUENCE'{components=Components} = Def#type.def,
365	    C = get_component(T,Components),
366	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
367				    FuncName,[T|TopTypeName]);
368	'CHOICE' ->
369	    {_,Components} = Def#type.def,
370	    C = get_component(T,Components),
371	    traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts,
372				    FuncName,[T|TopTypeName]);
373	'SEQUENCE OF' ->
374	    {_,Type} = Def#type.def,
375	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
376				       TopTypeName);
377	'SET OF' ->
378	    {_,Type} = Def#type.def,
379	    traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName,
380				       TopTypeName);
381	#'Externaltypereference'{module=M,type=TName} ->
382	    TypeDef = asn1_db:dbget(M,TName),
383	    traverse_type_structure(Erules,TypeDef,[T|Ts],FuncName,
384				    [TypeDef#typedef.name]);
385	_ ->
386            %% This may be a referenced type that shall be traversed
387            %% or the selected type
388	    traverse_type_structure(Erules,Def,Ts,FuncName,[T|TopTypeName])
389    end.
390
391traverse_SO_type_structure(Erules,Type,[N|Rest],FuncName,TopTypeName)
392  when is_integer(N) ->
393    traverse_type_structure(Erules,Type,Rest,FuncName,TopTypeName);
394traverse_SO_type_structure(Erules,Type,TypeList,FuncName,TopTypeName) ->
395    traverse_type_structure(Erules,Type,TypeList,FuncName,TopTypeName).
396
397get_component(Name,{C1,C2}) when is_list(C1),is_list(C2) ->
398    get_component(Name,C1++C2);
399get_component(Name,[C=#'ComponentType'{name=Name}|_Cs]) ->
400    C;
401get_component(Name,[_C|Cs]) ->
402    get_component(Name,Cs).
403
404%% generate code for all inner types that are called from the top type
405%% of the partial incomplete decode and are defined within the top
406%% type.Constructed subtypes deeper in the structure will be generated
407%% in turn after all top types have been generated.
408gen_dec_part_inner_constr(Rtmod,Erules,TypeDef,TypeName) ->
409    Def = TypeDef#typedef.typespec,
410    InnerType = asn1ct_gen:get_inner(Def#type.def),
411    case InnerType of
412	'SET' ->
413	    #'SET'{components=Components} = Def#type.def,
414	    gen_dec_part_inner_types(Rtmod,Erules,Components,TypeName);
415	%%  Continue generate the inner of each component
416	'SEQUENCE' ->
417	    #'SEQUENCE'{components=Components} = Def#type.def,
418	    gen_dec_part_inner_types(Rtmod,Erules,Components,TypeName);
419	'CHOICE' ->
420	    {_,Components} = Def#type.def,
421	    gen_dec_part_inner_types(Rtmod,Erules,Components,TypeName);
422	'SEQUENCE OF' ->
423	    %% this and next case must be the last component in the
424	    %% partial decode chain here. Not likely that this occur.
425	    {_,Type} = Def#type.def,
426	    NameSuffix = constructed_suffix(InnerType,Type#type.def),
427	    asn1ct_name:clear(),
428	    Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type);
429%%	    gen_types(Erules,[NameSuffix|Typename],Type);
430	'SET OF' ->
431	    {_,Type} = Def#type.def,
432	    NameSuffix = constructed_suffix(InnerType,Type#type.def),
433	    asn1ct_name:clear(),
434	    Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type);
435	_ ->
436	    ok
437    end.
438
439gen_dec_part_inner_types(Rtmod,Erules,[ComponentType|Rest],TypeName) ->
440    asn1ct_name:clear(),
441    Rtmod:gen_decode(Erules,TypeName,ComponentType),
442    gen_dec_part_inner_types(Rtmod,Erules,Rest,TypeName);
443gen_dec_part_inner_types(Rtmod,Erules,{Comps1,Comps2},TypeName)
444  when is_list(Comps1),is_list(Comps2) ->
445    gen_dec_part_inner_types(Rtmod,Erules,Comps1 ++ Comps2,TypeName);
446gen_dec_part_inner_types(_,_,[],_) ->
447    ok.
448
449
450pgen_partial_incomplete_decode(Erule) ->
451    case asn1ct:get_gen_state_field(active) of
452	true ->
453	    pgen_partial_incomplete_decode1(Erule),
454	    asn1ct:reset_gen_state();
455	_ ->
456	    ok
457    end.
458
459pgen_partial_incomplete_decode1(#gen{erule=ber}) ->
460    case asn1ct:read_config_data(partial_incomplete_decode) of
461	undefined ->
462	    ok;
463	Data ->
464	    lists:foreach(fun emit_partial_incomplete_decode/1,Data)
465    end,
466    GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs),
467    gen_part_decode_funcs(GeneratedFs,0);
468pgen_partial_incomplete_decode1(#gen{}) -> ok.
469
470emit_partial_incomplete_decode({FuncName,TopType,Pattern}) ->
471    TypePattern = asn1ct:get_gen_state_field(inc_type_pattern),
472    TPattern =
473	case lists:keysearch(FuncName,1,TypePattern) of
474	    {value,{_,TP}} -> TP;
475	    _ -> exit({error,{asn1_internal_error,exclusive_decode}})
476	end,
477    TopTypeName =
478	case asn1ct:maybe_saved_sindex(TopType,TPattern) of
479	    I when is_integer(I),I>0 ->
480		lists:concat([TopType,"_",I]);
481	    _ ->
482		atom_to_list(TopType)
483	end,
484    emit([{asis,FuncName},"(Bytes) ->",nl,
485	  "  decode_partial_incomplete('",TopTypeName,"',Bytes,",{asis,Pattern},").",nl]);
486emit_partial_incomplete_decode(D) ->
487    throw({error,{asn1,{"bad data in asn1config file",D}}}).
488
489gen_part_decode_funcs([Data={Name,_,_,Type}|GeneratedFs],N) ->
490    InnerType =
491	case Type#type.def of
492	    #'ObjectClassFieldType'{type=OCFTType} ->
493		OCFTType;
494	    _ ->
495		get_inner(Type#type.def)
496	end,
497    WhatKind = type(InnerType),
498    TypeName=list2name(Name),
499    if
500	N > 0 -> emit([";",nl]);
501	true -> ok
502    end,
503    emit(["decode_inc_disp('",TypeName,"',Data) ->",nl]),
504    gen_part_decode_funcs(WhatKind,TypeName,Data),
505    gen_part_decode_funcs(GeneratedFs,N+1);
506gen_part_decode_funcs([_H|T],N) ->
507    gen_part_decode_funcs(T,N);
508gen_part_decode_funcs([],N) ->
509    if
510	N > 0 ->
511	    emit([".",nl]);
512	true ->
513	    ok
514    end.
515
516gen_part_decode_funcs(#'Externaltypereference'{module=M,type=T},
517		      _TypeName,Data) ->
518    #typedef{typespec=TS} = asn1_db:dbget(M,T),
519    InnerType =
520	case TS#type.def of
521	    #'ObjectClassFieldType'{type=OCFTType} ->
522		OCFTType;
523	    _ ->
524		get_inner(TS#type.def)
525	end,
526    WhatKind = type(InnerType),
527    gen_part_decode_funcs(WhatKind,[T],Data);
528gen_part_decode_funcs({constructed,bif},TypeName,
529		      {_Name,parts,Tag,_Type}) ->
530    emit(["  case Data of",nl,
531	  "    L when is_list(L) ->",nl,
532	  "      'dec_",TypeName,"'(lists:map(fun(X) -> element(1, ",
533	  {call,ber,ber_decode_erlang,["X"]},") end, L),",{asis,Tag},");",nl,
534	  "    _ ->",nl,
535	  "      [Res] = 'dec_",TypeName,"'([Data],",{asis,Tag},"),",nl,
536	  "      Res",nl,
537	  "  end"]);
538gen_part_decode_funcs(WhatKind,_TypeName,{_Name,parts,_Tag,_Type}) ->
539    throw({error,{asn1,{"only SEQUENCE OF/SET OF may have the partial incomplete directive 'parts'.",WhatKind}}});
540gen_part_decode_funcs({constructed,bif},TypeName,
541		      {_Name,undecoded,Tag,_Type}) ->
542    emit(["  'dec_",TypeName,"'(Data,",{asis,Tag},")"]);
543gen_part_decode_funcs({primitive,bif},_TypeName,
544		      {_Name,undecoded,Tag,Type}) ->
545    asn1ct_gen_ber_bin_v2:gen_dec_prim(Type, "Data", Tag);
546gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) ->
547    throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}).
548
549%% EncDec = 'gen_encode' | 'gen_decode'
550gen_types(Erules, Tname, {RootL1,ExtList,RootL2}, EncDec)
551  when is_list(RootL1), is_list(RootL2) ->
552    gen_types(Erules, Tname, RootL1, EncDec),
553    Rtmod = ct_gen_module(Erules),
554    gen_types(Erules, Tname, Rtmod:extaddgroup2sequence(ExtList), EncDec),
555    gen_types(Erules, Tname, RootL2, EncDec);
556gen_types(Erules, Tname, {RootList,ExtList}, EncDec) when is_list(RootList) ->
557    gen_types(Erules, Tname, RootList, EncDec),
558    Rtmod = ct_gen_module(Erules),
559    gen_types(Erules, Tname, Rtmod:extaddgroup2sequence(ExtList), EncDec);
560gen_types(Erules, Tname, [{'EXTENSIONMARK',_,_}|T], EncDec) ->
561    gen_types(Erules, Tname, T, EncDec);
562gen_types(Erules, Tname, [ComponentType|T], EncDec) ->
563    asn1ct_name:clear(),
564    Rtmod = ct_gen_module(Erules),
565    Rtmod:EncDec(Erules, Tname, ComponentType),
566    gen_types(Erules, Tname, T, EncDec);
567gen_types(_, _, [], _) ->
568    ok;
569gen_types(Erules, Tname, #type{}=Type, EncDec) ->
570    asn1ct_name:clear(),
571    Rtmod = ct_gen_module(Erules),
572    Rtmod:EncDec(Erules, Tname, Type).
573
574%% VARIOUS GENERATOR STUFF
575%% *************************************************
576%%**************************************************
577
578mk_var(X) when is_atom(X) ->
579    list_to_atom(mk_var(atom_to_list(X)));
580
581mk_var([H|T]) ->
582    [H-32|T].
583
584%% Since hyphens are allowed in ASN.1 names, it may occur in a
585%% variable to. Turn a hyphen into a under-score sign.
586un_hyphen_var(X) when is_atom(X) ->
587    list_to_atom(un_hyphen_var(atom_to_list(X)));
588un_hyphen_var([45|T]) ->
589    [95|un_hyphen_var(T)];
590un_hyphen_var([H|T]) ->
591    [H|un_hyphen_var(T)];
592un_hyphen_var([]) ->
593    [].
594
595gen_encode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) ->
596    Rtmod = ct_constructed_module(Erules),
597    case InnerType of
598	'SET' ->
599	    Rtmod:gen_encode_set(Erules,Typename,D),
600	    #'SET'{components=Components} = D#type.def,
601	    gen_types(Erules, Typename, Components, gen_encode);
602	'SEQUENCE' ->
603	    Rtmod:gen_encode_sequence(Erules,Typename,D),
604	    #'SEQUENCE'{components=Components} = D#type.def,
605	    gen_types(Erules, Typename, Components, gen_encode);
606	'CHOICE' ->
607	    Rtmod:gen_encode_choice(Erules,Typename,D),
608	    {_,Components} = D#type.def,
609	    gen_types(Erules, Typename, Components, gen_encode);
610	'SEQUENCE OF' ->
611	    Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
612	    {_,Type} = D#type.def,
613	    NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
614	    gen_types(Erules, [NameSuffix|Typename], Type, gen_encode);
615	'SET OF' ->
616	    Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
617	    {_,Type} = D#type.def,
618	    NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
619	    gen_types(Erules, [NameSuffix|Typename], Type, gen_encode)
620    end;
621gen_encode_constructed(Erules,Typename,InnerType,D)
622  when is_record(D,typedef) ->
623    gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec).
624
625gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) ->
626    Rtmod = ct_constructed_module(Erules),
627    asn1ct:step_in_constructed(), %% updates namelist for exclusive decode
628    case InnerType of
629	'SET' ->
630	    Rtmod:gen_decode_set(Erules,Typename,D),
631	    #'SET'{components=Components} = D#type.def,
632	    gen_types(Erules, Typename, Components, gen_decode);
633	'SEQUENCE' ->
634	    Rtmod:gen_decode_sequence(Erules,Typename,D),
635	    #'SEQUENCE'{components=Components} = D#type.def,
636	    gen_types(Erules, Typename, Components, gen_decode);
637	'CHOICE' ->
638	    Rtmod:gen_decode_choice(Erules,Typename,D),
639	    {_,Components} = D#type.def,
640	    gen_types(Erules, Typename, Components, gen_decode);
641	'SEQUENCE OF' ->
642	    Rtmod:gen_decode_sof(Erules,Typename,InnerType,D),
643	    {_,#type{def=Def}=Type} = D#type.def,
644	    NameSuffix = asn1ct_gen:constructed_suffix(InnerType, Def),
645	    gen_types(Erules, [NameSuffix|Typename], Type, gen_decode);
646	'SET OF' ->
647	    Rtmod:gen_decode_sof(Erules,Typename,InnerType,D),
648	    {_,#type{def=Def}=Type} = D#type.def,
649	    NameSuffix = asn1ct_gen:constructed_suffix(InnerType, Def),
650	    gen_types(Erules, [NameSuffix|Typename], Type, gen_decode)
651    end;
652
653gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) ->
654    gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec).
655
656
657pgen_exports(#gen{options=Options}=Gen, Code) ->
658    #abst{types=Types,values=Values,objects=Objects,objsets=ObjectSets} = Code,
659    emit(["-export([encoding_rule/0,maps/0,bit_string_format/0,",nl,
660	  "         legacy_erlang_types/0]).",nl]),
661    emit(["-export([",{asis,?SUPPRESSION_FUNC},"/1]).",nl]),
662    case Gen of
663        #gen{erule=ber} ->
664            gen_exports(Types, "enc_", 2),
665            gen_exports(Types, "dec_", 2),
666            gen_exports(Objects, "enc_", 3),
667            gen_exports(Objects, "dec_", 3),
668            gen_exports(ObjectSets, "getenc_", 1),
669            gen_exports(ObjectSets, "getdec_", 1),
670            case Gen#gen.jer of
671                true ->
672                    gen_exports(Types, "typeinfo_", 0);
673                _ ->
674                    true
675            end;
676        #gen{erule=per} ->
677            gen_exports(Types, "enc_", 1),
678            gen_exports(Types, "dec_", 1),
679            case Gen#gen.jer of
680                true ->
681                    gen_exports(Types, "typeinfo_", 0);
682                _ ->
683                    true
684            end;
685        #gen{erule=jer} ->
686            gen_exports(Types, "typeinfo_", 0),
687            gen_exports(ObjectSets, "typeinfo_", 0)
688%%            gen_exports(Types, "dec_", 1)
689    end,
690
691    A2nNames = [X || {n2n,X} <- Options],
692    gen_exports(A2nNames, "name2num_", 1),
693    gen_exports(A2nNames, "num2name_", 1),
694
695    gen_exports(Values, "", 0),
696    emit(["-export([info/0]).",nl,nl]),
697    gen_partial_inc_decode_exports(),
698    gen_selected_decode_exports().
699
700gen_partial_inc_decode_exports() ->
701    case {asn1ct:read_config_data(partial_incomplete_decode),
702	  asn1ct:get_gen_state_field(inc_type_pattern)}  of
703	{undefined,_} ->
704	    ok;
705	{_,undefined} ->
706	    ok;
707	{Data0,_} ->
708            Data = [Name || {Name,_,_} <- Data0],
709            gen_exports(Data, "", 1),
710            emit(["-export([decode_part/2]).",nl,nl])
711    end.
712
713gen_selected_decode_exports() ->
714    case asn1ct:get_gen_state_field(type_pattern) of
715	undefined ->
716	    ok;
717	Data0 ->
718            Data = [Name || {Name,_} <- Data0],
719            gen_exports(Data, "", 1)
720    end.
721
722gen_exports([], _Prefix, _Arity) ->
723    ok;
724gen_exports([_|_]=L0, Prefix, Arity) ->
725    FF = fun(F0) ->
726                 F = list_to_atom(lists:concat([Prefix,F0])),
727                 [{asis,F},"/",Arity]
728         end,
729    L = lists:join(",\n", [FF(F) || F <- L0]),
730    emit(["-export([",nl,
731          L,nl,
732          "]).",nl,nl]).
733
734pgen_dispatcher(Erules, []) ->
735    gen_info_functions(Erules);
736pgen_dispatcher(Gen, Types) ->
737    %% MODULE HEAD
738    emit(["-export([encode/2,decode/2]).",nl]),
739    case Gen#gen.jer of
740        true ->
741            emit(["-export([jer_encode/2,jer_decode/2]).",nl]);
742        false ->
743            ok
744    end,
745    emit([nl]),
746    gen_info_functions(Gen),
747
748    Options = Gen#gen.options,
749    NoFinalPadding = lists:member(no_final_padding, Options),
750    NoOkWrapper = proplists:get_bool(no_ok_wrapper, Options),
751    CurrMod = lists:concat(["'",get(currmod),"'"]),
752
753    %% ENCODER
754    Call = case Gen of
755	       #gen{erule=per,aligned=true} ->
756		   asn1ct_func:need({per,complete,1}),
757		   "complete(encode_disp(Type, Data))";
758	       #gen{erule=ber} ->
759		   "iolist_to_binary(element(1, encode_disp(Type, Data)))";
760               #gen{erule=jer} ->
761                   ["?JSON_ENCODE(",
762                    {call,jer,encode_jer,[CurrMod,
763                                          "list_to_existing_atom(lists:concat([typeinfo_,Type]))",
764                                          "Data"]},")"];
765	       #gen{erule=per,aligned=false} when NoFinalPadding ->
766		   asn1ct_func:need({uper,complete_NFP,1}),
767		   "complete_NFP(encode_disp(Type, Data))";
768	       #gen{erule=per,aligned=false} ->
769		   asn1ct_func:need({uper,complete,1}),
770		   "complete(encode_disp(Type, Data))"
771	   end,
772
773    emit(["encode(Type, Data) ->",nl]),
774    case NoOkWrapper of
775	true ->
776	    emit(["  ",Call,"."]);
777	false ->
778	    emit(["try ",Call," of",nl,
779		  "  Bytes ->",nl,
780		  "    {ok,Bytes}",nl,
781		  try_catch()])
782    end,
783    emit([nl,nl]),
784
785    case Gen#gen.jer of
786        true ->
787            emit(["jer_encode(Type, Data) ->",nl]),
788            JerCall = ["?JSON_ENCODE(",
789                    {call,jer,encode_jer,
790                     [CurrMod,
791                      "list_to_existing_atom(lists:concat([typeinfo_,Type]))",
792                      "Data"]},")"],
793            case NoOkWrapper of
794                true ->
795                    emit(["  ",JerCall,"."]);
796                false ->
797                    emit(["try ",JerCall," of",nl,
798                          "  Bytes ->",nl,
799                          "    {ok,Bytes}",nl,
800                          try_catch()])
801            end,
802            emit([nl,nl]);
803        false ->
804            ok
805    end,
806    %% DECODER
807    ReturnRest = proplists:get_bool(undec_rest, Gen#gen.options),
808    Data = case Gen#gen.erule =:= ber andalso ReturnRest of
809	       true -> "Data0";
810	       false -> "Data"
811	   end,
812
813    emit(["decode(Type, ",Data,") ->",nl]),
814
815    case NoOkWrapper of
816        false -> emit(["try",nl]);
817        true -> ok
818    end,
819
820    DecWrap =
821	case {Gen,ReturnRest} of
822	    {#gen{erule=ber},false} ->
823		asn1ct_func:need({ber,ber_decode_nif,1}),
824		"element(1, ber_decode_nif(Data))";
825	    {#gen{erule=ber},true} ->
826		asn1ct_func:need({ber,ber_decode_nif,1}),
827		emit(["   {Data,Rest} = ber_decode_nif(Data0),",nl]),
828		"Data";
829	    {#gen{erule=jer},false} ->
830		"?JSON_DECODE(Data)";
831	    {#gen{erule=jer},true} ->
832		exit("JER + return rest not supported");
833	    {_,_} ->
834		"Data"
835	end,
836
837    DecodeDisp = ["decode_disp(Type, ",DecWrap,")"],
838    case {Gen,ReturnRest} of
839	{#gen{erule=ber},true} ->
840	    emit(["   Result = ",DecodeDisp,",",nl]),
841            result_line(NoOkWrapper, ["Result","Rest"]);
842	{#gen{erule=ber},false} ->
843	    emit(["   Result = ",DecodeDisp,",",nl]),
844            result_line(NoOkWrapper, ["Result"]);
845	{#gen{erule=jer},false} ->
846	    emit(["   Result = ",{call,jer,decode_jer,[ CurrMod,
847                                                        "list_to_existing_atom(lists:concat([typeinfo_,Type]))",
848                                                        DecWrap]},",",nl]),
849            result_line(NoOkWrapper, ["Result"]);
850
851
852	{#gen{erule=per},true} ->
853	    emit(["   {Result,Rest} = ",DecodeDisp,",",nl]),
854            result_line(NoOkWrapper, ["Result","Rest"]);
855	{#gen{erule=per},false} ->
856	    emit(["   {Result,_Rest} = ",DecodeDisp,",",nl]),
857            result_line(NoOkWrapper, ["Result"])
858    end,
859
860    case NoOkWrapper of
861	false ->
862	    emit([nl,try_catch(),nl,nl]);
863	true ->
864	    emit([".",nl,nl])
865    end,
866
867    case Gen#gen.jer of
868        true ->
869            emit(["jer_decode(Type, ",Data,") ->",nl]),
870            case NoOkWrapper of
871                false -> emit(["try",nl]);
872                true -> ok
873            end,
874            JerDecWrap = "?JSON_DECODE(Data)",
875	    emit(["   Result = ",
876                  {call,jer,
877                   decode_jer,
878                   [CurrMod,
879                    "list_to_existing_atom(lists:concat([typeinfo_,Type]))",
880                    JerDecWrap]},",",nl]),
881            result_line(false, ["Result"]),
882            case NoOkWrapper of
883                false ->
884                    emit([nl,try_catch(),nl,nl]);
885                true ->
886                    emit([".",nl,nl])
887            end;
888        false ->
889            ok
890    end,
891
892
893    %% REST of MODULE
894    gen_decode_partial_incomplete(Gen),
895    gen_partial_inc_dispatcher(Gen),
896
897    case Gen of
898        #gen{erule=jer} ->
899            ok;
900        _ ->
901            gen_dispatcher(Types, "encode_disp", "enc_"),
902            gen_dispatcher(Types, "decode_disp", "dec_")
903    end.
904
905result_line(NoOkWrapper, Items) ->
906    S = ["   "|case NoOkWrapper of
907		    false -> result_line_1(["ok"|Items]);
908		    true -> result_line_1(Items)
909		end],
910    emit(lists:flatten(S)).
911
912result_line_1([SingleItem]) ->
913    SingleItem;
914result_line_1(Items) ->
915    ["{",lists:join(",",Items),"}"].
916
917try_catch() ->
918    ["  catch",nl,
919     "    Class:Exception:Stk when Class =:= error; Class =:= exit ->",nl,
920     "      case Exception of",nl,
921     "        {error,{asn1,Reason}} ->",nl,
922     "          {error,{asn1,{Reason,Stk}}};",nl,
923     "        Reason ->",nl,
924     "         {error,{asn1,{Reason,Stk}}}",nl,
925     "      end",nl,
926     "end."].
927
928gen_info_functions(Gen) ->
929    Erule = case Gen of
930                #gen{erule=ber} -> ber;
931                #gen{erule=per,aligned=false} -> uper;
932                #gen{erule=per,aligned=true} -> per;
933                #gen{erule=jer} -> jer
934            end,
935    Maps = case Gen of
936               #gen{pack=record} -> false;
937               #gen{pack=map} -> true
938           end,
939    emit(["encoding_rule() -> ",
940	  {asis,Erule},".",nl,nl,
941          "maps() -> ",
942          {asis,Maps},".",nl,nl,
943	  "bit_string_format() -> ",
944	  {asis,asn1ct:get_bit_string_format()},".",nl,nl,
945	  "legacy_erlang_types() -> ",
946	  {asis,asn1ct:use_legacy_types()},".",nl,nl]).
947
948gen_decode_partial_incomplete(#gen{erule=ber}) ->
949    case {asn1ct:read_config_data(partial_incomplete_decode),
950	  asn1ct:get_gen_state_field(inc_type_pattern)} of
951	{undefined,_} ->
952	    ok;
953	{_,undefined} ->
954	    ok;
955	_ ->
956	    EmitCaseClauses =
957		fun() ->
958			emit(["   {'EXIT',{error,Reason}} ->",nl,
959			      "      {error,Reason};",nl,
960			      "    {'EXIT',Reason} ->",nl,
961			      "      {error,{asn1,Reason}};",nl,
962			      "    Result ->",nl,
963			      "      {ok,Result}",nl,
964			      "  end"])
965		end,
966	    emit(["decode_partial_incomplete(Type,Data0,",
967		  "Pattern) ->",nl]),
968	    emit(["  {Data,_RestBin} =",nl,
969		  "    ",{call,ber,decode_primitive_incomplete,
970			  ["Pattern","Data0"]},com,nl,
971		  "  case catch decode_partial_inc_disp(Type,",
972		  "Data) of",nl]),
973	    EmitCaseClauses(),
974	    emit([".",nl,nl]),
975	    emit(["decode_part(Type, Data0) "
976		  "when is_binary(Data0) ->",nl]),
977	    emit(["  case catch decode_inc_disp(Type,element(1, ",
978		  {call,ber,ber_decode_nif,["Data0"]},")) of",nl]),
979	    EmitCaseClauses(),
980	    emit([";",nl]),
981	    emit(["decode_part(Type, Data0) ->",nl]),
982	    emit(["  case catch decode_inc_disp(Type, Data0) of",nl]),
983	    EmitCaseClauses(),
984	    emit([".",nl,nl])
985    end;
986gen_decode_partial_incomplete(#gen{}) ->
987    ok.
988
989gen_partial_inc_dispatcher(#gen{erule=ber}) ->
990    case {asn1ct:read_config_data(partial_incomplete_decode),
991	  asn1ct:get_gen_state_field(inc_type_pattern)} of
992	{undefined,_} ->
993	    ok;
994	{_,undefined} ->
995	    ok;
996	{Data1,Data2} ->
997	    gen_partial_inc_dispatcher(Data1, Data2, "")
998    end;
999gen_partial_inc_dispatcher(#gen{}) ->
1000    ok.
1001
1002gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest], TypePattern, Sep) ->
1003    TPattern =
1004	case lists:keysearch(FuncName,1,TypePattern) of
1005	    {value,{_,TP}} -> TP;
1006	    _ -> exit({error,{asn1_internal_error,exclusive_decode}})
1007	end,
1008    FuncName2=asn1ct:maybe_rename_function(inc_disp,TopType,TPattern),
1009    TopTypeName =
1010	case asn1ct:maybe_saved_sindex(TopType,TPattern) of
1011	    I when is_integer(I),I>0 ->
1012		lists:concat([TopType,"_",I]);
1013	    _ ->
1014		atom_to_list(TopType)
1015	end,
1016    emit([Sep,
1017	  "decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl,
1018	  "  ",{asis,list_to_atom(lists:concat(["dec-inc-",FuncName2]))},
1019	  "(Data)"]),
1020    gen_partial_inc_dispatcher(Rest, TypePattern, ";\n");
1021gen_partial_inc_dispatcher([], _, _) ->
1022    emit([".",nl]).
1023
1024gen_dispatcher(L, DispFunc, Prefix) ->
1025    gen_dispatcher_1(L, DispFunc, Prefix),
1026    emit([DispFunc,"(","Type",", _Data) ->"
1027          " exit({error,{asn1,{undefined_type,Type}}}).",nl,nl]).
1028
1029gen_dispatcher_1([F|T], FuncName, Prefix) ->
1030    Func = list_to_atom(lists:concat([Prefix,F])),
1031    emit([FuncName,"(",{asis,F},", Data) -> ",
1032          {asis,Func},"(Data)",";",nl]),
1033    gen_dispatcher_1(T, FuncName, Prefix);
1034gen_dispatcher_1([], _, _) ->
1035    ok.
1036
1037pgen_info() ->
1038    emit(["info() ->",nl,
1039	  "   case ?MODULE:module_info(attributes) of",nl,
1040	  "     Attributes when is_list(Attributes) ->",nl,
1041	  "       case lists:keyfind(asn1_info, 1, Attributes) of",nl,
1042	  "         {_,Info} when is_list(Info) ->",nl,
1043	  "           Info;",nl,
1044	  "         _ ->",nl,
1045	  "           []",nl,
1046	  "       end;",nl,
1047	  "     _ ->",nl,
1048	  "       []",nl,
1049	  "   end.",nl]).
1050
1051open_hrl(OutFile,Module) ->
1052    File = lists:concat([OutFile,".hrl"]),
1053    _ = open_output_file(File),
1054    gen_hrlhead(Module),
1055    Protector = hrl_protector(OutFile),
1056    emit(["-ifndef(",Protector,").\n",
1057	  "-define(",Protector,", true).\n"
1058	  "\n"]).
1059
1060hrl_protector(OutFile) ->
1061    BaseName = filename:basename(OutFile),
1062    P = "_" ++ string:uppercase(BaseName) ++ "_HRL_",
1063    [if
1064	 $A =< C, C =< $Z -> C;
1065	 $a =< C, C =< $a -> C;
1066	 $0 =< C, C =< $9 -> C;
1067	 true -> $_
1068     end || C <- P].
1069
1070
1071emit(Term) ->
1072    ok = file:write(get(gen_file_out), do_emit(Term)).
1073
1074do_emit({prev,Variable}) when is_atom(Variable) ->
1075    do_emit({var,asn1ct_name:prev(Variable)});
1076do_emit({next,Variable}) when is_atom(Variable) ->
1077    do_emit({var,asn1ct_name:next(Variable)});
1078do_emit({curr,Variable}) when is_atom(Variable) ->
1079    do_emit({var,asn1ct_name:curr(Variable)});
1080do_emit({var,Variable}) when is_atom(Variable) ->
1081    [Head|V] = atom_to_list(Variable),
1082    [Head-32|V];
1083do_emit({asis,What}) ->
1084    io_lib:format("~w", [What]);
1085do_emit({asisp,What}) ->
1086    io_lib:format("~p", [What]);
1087do_emit({call,M,F,A}) ->
1088    MFA = {M,F,length(A)},
1089    asn1ct_func:need(MFA),
1090    [atom_to_list(F),"(",call_args(A, "")|")"];
1091do_emit(nl) ->
1092    "\n";
1093do_emit(com) ->
1094    ",";
1095do_emit([C|_]=Str) when is_integer(C) ->
1096    Str;
1097do_emit([_|_]=L) ->
1098    [do_emit(E) || E <- L];
1099do_emit([]) ->
1100    [];
1101do_emit(What) when is_integer(What) ->
1102    integer_to_list(What);
1103do_emit(What) when is_atom(What) ->
1104    atom_to_list(What).
1105
1106
1107call_args([A|As], Sep) ->
1108    [Sep,do_emit(A)|call_args(As, ", ")];
1109call_args([], _) -> [].
1110
1111open_output_file(F) ->
1112    case file:open(F, [write,raw,delayed_write]) of
1113	{ok,Fd} ->
1114	    put(gen_file_out, Fd),
1115	    Fd;
1116	{error, Reason} ->
1117	    io:format("** Can't open file ~p ~n", [F]),
1118	    exit({error,Reason})
1119    end.
1120
1121close_output_file() ->
1122    ok = file:close(erase(gen_file_out)).
1123
1124pgen_hrl(#gen{pack=record}=Gen, Code) ->
1125    #abst{name=Module,types=Types,values=Values,ptypes=Ptypes} = Code,
1126    Ret =
1127	case pgen_hrltypes(Gen, Module, Ptypes++Types, 0) of
1128	    0 ->
1129		case Values of
1130		    [] ->
1131			0;
1132		    _ ->
1133			open_hrl(get(outfile), Module),
1134			pgen_macros(Gen, Module, Values),
1135			1
1136		end;
1137	    X ->
1138		pgen_macros(Gen, Module, Values),
1139		X
1140	end,
1141    case Ret of
1142        0 ->
1143            0;
1144        Y ->
1145            Protector = hrl_protector(get(outfile)),
1146            emit(["-endif. %% ",Protector,"\n"]),
1147            close_output_file(),
1148            asn1ct:verbose("--~p--~n",
1149                           [{generated,lists:concat([get(outfile),".hrl"])}],
1150                           Gen),
1151            Y
1152    end;
1153pgen_hrl(#gen{pack=map}, _) ->
1154    0.
1155
1156pgen_macros(_,_,[]) ->
1157    true;
1158pgen_macros(Gen, Module, [H|T]) ->
1159    Valuedef = asn1_db:dbget(Module, H),
1160    gen_macro(Gen, Valuedef),
1161    pgen_macros(Gen, Module, T).
1162
1163pgen_hrltypes(_,_,[],NumRecords) ->
1164    NumRecords;
1165pgen_hrltypes(Gen, Module, [H|T], NumRecords) ->
1166    Typedef = asn1_db:dbget(Module, H),
1167    AddNumRecords = gen_record(Gen, Typedef, NumRecords),
1168    pgen_hrltypes(Gen, Module, T, NumRecords+AddNumRecords).
1169
1170
1171%% Generates a macro for value Value defined in the ASN.1 module
1172gen_macro(Gen, #valuedef{name=Name,value=Value}) ->
1173    Prefix = get_macro_name_prefix(Gen),
1174    emit(["-define('",Prefix,Name,"', ",{asis,Value},").",nl]).
1175
1176%% Generate record functions **************
1177%% Generates an Erlang record for each named and unnamed SEQUENCE and SET in the ASN.1
1178%% module. If no SEQUENCE or SET is found there is no .hrl file generated
1179
1180
1181gen_record(Gen, #typedef{}=Tdef, NumRecords) ->
1182    Name = [Tdef#typedef.name],
1183    Type = Tdef#typedef.typespec,
1184    gen_record(Gen, type, Name, Type, NumRecords);
1185gen_record(Gen, #ptypedef{}=Tdef, NumRecords) ->
1186    Name = [Tdef#ptypedef.name],
1187    Type = Tdef#ptypedef.typespec,
1188    gen_record(Gen, ptype, Name, Type, NumRecords).
1189
1190gen_record(Gen, TorPtype, Name,
1191           [#'ComponentType'{name=Cname,typespec=Type}|T], Num) ->
1192    Num2 = gen_record(Gen, TorPtype, [Cname|Name], Type, Num),
1193    gen_record(Gen, TorPtype, Name, T, Num2);
1194gen_record(Gen, TorPtype, Name, {Clist1,Clist2}, Num)
1195  when is_list(Clist1), is_list(Clist2) ->
1196    gen_record(Gen, TorPtype, Name, Clist1++Clist2, Num);
1197gen_record(Gen, TorPtype, Name, {Clist1,EClist,Clist2}, Num)
1198  when is_list(Clist1), is_list(EClist), is_list(Clist2) ->
1199    gen_record(Gen, TorPtype, Name, Clist1++EClist++Clist2, Num);
1200gen_record(Gen, TorPtype, Name, [_|T], Num) -> % skip EXTENSIONMARK
1201    gen_record(Gen, TorPtype, Name, T, Num);
1202gen_record(_Gen, _TorPtype, _Name, [], Num) ->
1203    Num;
1204gen_record(Gen, TorPtype, Name, #type{}=Type, Num) ->
1205    Def = Type#type.def,
1206    Rec = case Def of
1207	      Seq when is_record(Seq,'SEQUENCE') ->
1208		  case Seq#'SEQUENCE'.pname of
1209		      false ->
1210			  {record,Seq#'SEQUENCE'.components};
1211		      _ ->
1212			  {record,Seq#'SEQUENCE'.components}
1213		  end;
1214	      Set when is_record(Set,'SET') ->
1215		  case Set#'SET'.pname of
1216		      false ->
1217			  {record,to_textual_order(Set#'SET'.components)};
1218		      _Pname when TorPtype == type ->
1219			  false;
1220		      _ ->
1221			  {record,to_textual_order(Set#'SET'.components)}
1222		  end;
1223	      {'CHOICE',_CompList} -> {inner,Def};
1224	      {'SEQUENCE OF',_CompList} -> {['SEQOF'|Name],Def};
1225	      {'SET OF',_CompList} -> {['SETOF'|Name],Def};
1226	      _ -> false
1227    end,
1228    case Rec of
1229	false -> Num;
1230	{record,CompList} ->
1231	    case Num of
1232		0 -> open_hrl(get(outfile),get(currmod));
1233		_ -> true
1234	    end,
1235            do_gen_record(Gen, Name, CompList),
1236	    NewCompList =
1237		case CompList of
1238		    {CompList1,[]} ->
1239			CompList1;
1240		    {Tr,ExtensionList2} ->
1241			Tr ++ ExtensionList2;
1242		    {Rootl1,Extl,Rootl2} ->
1243			Rootl1++Extl++Rootl2;
1244		    _ ->
1245			CompList
1246		end,
1247	    gen_record(Gen, TorPtype, Name, NewCompList, Num+1);
1248	{inner,{'CHOICE', CompList}} ->
1249	    gen_record(Gen, TorPtype, Name, CompList, Num);
1250	{NewName,{_, CompList}} ->
1251	    gen_record(Gen, TorPtype, NewName, CompList, Num)
1252    end;
1253gen_record(_, _, _, _, NumRecords) ->        % skip CLASS etc for now.
1254     NumRecords.
1255
1256do_gen_record(Gen, Name, CL0) when is_list(CL0) ->
1257    do_gen_record_0(Gen, Name, complist_as_tuple(CL0));
1258do_gen_record(Gen, Name, CL0) ->
1259    do_gen_record_0(Gen, Name, CL0).
1260
1261do_gen_record_0(Gen, Name, CL0) ->
1262    CL = case CL0 of
1263             {Root,[]} ->
1264                 Root ++ [{comment,"with extension mark"}];
1265             {Root,Ext} ->
1266                 Root ++ [{comment,"with extensions"}] ++
1267                     only_components(Ext);
1268             {Root1,Ext,Root2} ->
1269                 Root1 ++ [{comment,"with extensions"}] ++
1270                     only_components(Ext) ++
1271                     [{comment,"end of extensions"}] ++ Root2;
1272             _ when is_list(CL0) ->
1273                 only_components(CL0)
1274         end,
1275    Prefix = get_record_name_prefix(Gen),
1276    emit(["-record('",Prefix,list2name(Name),"', {"] ++
1277             do_gen_record_1(CL) ++
1278             [nl,"}).",nl,nl]).
1279
1280only_components(CL) ->
1281    [C || #'ComponentType'{}=C <- CL].
1282
1283do_gen_record_1([#'ComponentType'{name=Name,prop=Prop}|T]) ->
1284    Val = case Prop of
1285              'OPTIONAL' ->
1286                  " = asn1_NOVALUE";
1287              {'DEFAULT',_} ->
1288                  " = asn1_DEFAULT";
1289              _ ->
1290                  []
1291          end,
1292    Com = case needs_trailing_comma(T) of
1293        true -> [com];
1294        false -> []
1295    end,
1296    [nl,"  ",{asis,Name},Val,Com|do_gen_record_1(T)];
1297do_gen_record_1([{comment,Text}|T]) ->
1298    [nl,"  %% ",Text|do_gen_record_1(T)];
1299do_gen_record_1([]) ->
1300    [].
1301
1302needs_trailing_comma([#'ComponentType'{}|_]) -> true;
1303needs_trailing_comma([_|T]) -> needs_trailing_comma(T);
1304needs_trailing_comma([]) -> false.
1305
1306gen_head(#gen{options=Options}=Gen, Mod, Hrl) ->
1307    Name = case Gen of
1308               #gen{erule=per,aligned=false} ->
1309                   "PER (unaligned)";
1310               #gen{erule=per,aligned=true} ->
1311                   "PER (aligned)";
1312               #gen{erule=ber} ->
1313                   "BER";
1314               #gen{erule=jer} ->
1315                   "JER (JSON)"
1316           end,
1317    emit(["%% Generated by the Erlang ASN.1 ",Name,
1318          " compiler. Version: ",asn1ct:vsn(),nl,
1319          "%% Purpose: Encoding and decoding of the types in ",
1320          Mod,".",nl,nl,
1321          "-module('",Mod,"').",nl,
1322          "-compile(nowarn_unused_vars).",nl,
1323          "-dialyzer(no_improper_lists).",nl,
1324          "-dialyzer(no_match).",nl
1325         ]),
1326    case Hrl of
1327	0 -> ok;
1328	_ -> emit(["-include(\"",Mod,".hrl\").",nl])
1329    end,
1330    emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl,
1331	  "            {module,'",Mod,"'},",nl,
1332	  "            {options,",io_lib:format("~p",[Options]),"}]).",nl,nl]),
1333    JerDefines = case Gen of
1334                     #gen{erule=jer} ->
1335                         true;
1336                     #gen{jer=true} ->
1337                         true;
1338                     _ ->
1339                         false
1340                 end,
1341    JerDefines andalso
1342%% FIXME add jiffy as well and maybe a third argument where the user
1343%% can provide the JSON encode/decode as a fun (or atom).
1344        emit([
1345              "-ifdef(jsone).",nl,
1346              "-define(JSON_DECODE(Data),jsone:decode(Data)).",nl,
1347              "-define(JSON_ENCODE(Term),jsone:encode(Term)).",nl,
1348              "-else.",nl,
1349              "-define(JSON_DECODE(Data),jsx:decode(Data,[return_maps])).",nl,
1350              "-define(JSON_ENCODE(Term),jsx:encode(Term)).",nl,
1351              "-endif.",nl
1352             ]).
1353
1354gen_hrlhead(Mod) ->
1355    emit(["%% Generated by the Erlang ASN.1 compiler. Version: ",
1356          asn1ct:vsn(),nl,
1357          "%% Purpose: Erlang record definitions for each named and unnamed",nl,
1358          "%% SEQUENCE and SET, and macro definitions for each value",nl,
1359          "%% definition in module ",Mod,".",nl,nl]).
1360
1361%% May only be a list or a two-tuple.
1362to_textual_order({Root,Ext}) ->
1363    {to_textual_order(Root),Ext};
1364to_textual_order(Cs={_R1,_Ext,_R2}) ->
1365    Cs;
1366to_textual_order(Cs=[#'ComponentType'{textual_order=undefined}|_]) ->
1367    Cs;
1368to_textual_order(Cs) when is_list(Cs) ->
1369    lists:keysort(#'ComponentType'.textual_order,Cs).
1370
1371insert_once(Table,Object) ->
1372    case asn1ct_table:lookup(Table, element(1, Object)) of
1373	[] ->
1374	    asn1ct_table:insert(Table, Object); %returns true
1375	_ -> false
1376    end.
1377
1378unify_if_string(PrimType) ->
1379    case PrimType of
1380	'NumericString' ->
1381	    restrictedstring;
1382	'PrintableString' ->
1383	    restrictedstring;
1384	'TeletexString' ->
1385	    restrictedstring;
1386	'T61String' ->
1387	    restrictedstring;
1388	'VideotexString' ->
1389	    restrictedstring;
1390	'IA5String' ->
1391	    restrictedstring;
1392	'UTCTime' ->
1393	    restrictedstring;
1394	'GeneralizedTime' ->
1395	    restrictedstring;
1396	'GraphicString' ->
1397	    restrictedstring;
1398	'VisibleString' ->
1399	    restrictedstring;
1400	'GeneralString' ->
1401	    restrictedstring;
1402	'UniversalString' ->
1403	    restrictedstring;
1404	'BMPString' ->
1405	    restrictedstring;
1406	'UTF8String' ->
1407	    restrictedstring;
1408	Other -> Other
1409    end.
1410
1411conform_value(#type{def={'BIT STRING',[]}}, Bs) ->
1412    case asn1ct:get_bit_string_format() of
1413	compact when is_binary(Bs) ->
1414	    {0,Bs};
1415	compact when is_bitstring(Bs) ->
1416	    Sz = bit_size(Bs),
1417	    Unused = 8 - bit_size(Bs),
1418	    {Unused,<<Bs:Sz/bits,0:Unused>>};
1419	legacy ->
1420	    [B || <<B:1>> <= Bs];
1421	bitstring when is_bitstring(Bs) ->
1422	    Bs
1423    end;
1424conform_value(#type{def='OCTET STRING'}, String) ->
1425    case asn1ct:use_legacy_types() of
1426	false -> String;
1427	true -> binary_to_list(String)
1428    end;
1429conform_value(_, Value) -> Value.
1430
1431named_bitstring_value(List, Names) ->
1432    Int = lists:foldl(fun(N, A) ->
1433			      {N,Pos} = lists:keyfind(N, 1, Names),
1434			      A bor (1 bsl Pos)
1435		      end, 0, List),
1436    named_bitstring_value_1(<<>>, Int).
1437
1438named_bitstring_value_1(Bs, 0) ->
1439    Bs;
1440named_bitstring_value_1(Bs, Int) ->
1441    B = Int band 1,
1442    named_bitstring_value_1(<<Bs/bitstring,B:1>>, Int bsr 1).
1443
1444get_inner(A) when is_atom(A) -> A;
1445get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext;
1446get_inner({fixedtypevaluefield,_,Type}) ->
1447    if
1448	is_record(Type,type) ->
1449	    get_inner(Type#type.def);
1450	true ->
1451	    get_inner(Type)
1452    end;
1453get_inner({typefield,TypeName}) ->
1454    TypeName;
1455get_inner(#'ObjectClassFieldType'{type=Type}) ->
1456    Type;
1457get_inner(T) when is_tuple(T) ->
1458    case element(1,T) of
1459	Tuple when is_tuple(Tuple),element(1,Tuple) == objectclass ->
1460	    case catch(lists:last(element(2,T))) of
1461		{valuefieldreference,FieldName} ->
1462		    get_fieldtype(element(2,Tuple),FieldName);
1463		{typefieldreference,FieldName} ->
1464		    get_fieldtype(element(2,Tuple),FieldName)
1465	    end;
1466	_ -> element(1,T)
1467    end.
1468
1469
1470
1471
1472
1473type(X) when is_record(X,'Externaltypereference') ->
1474    X;
1475type('ASN1_OPEN_TYPE') ->
1476    'ASN1_OPEN_TYPE';
1477type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) ->
1478    type(get_inner(Type#type.def));
1479type({typefield,_}) ->
1480    'ASN1_OPEN_TYPE';
1481type(X) ->
1482    case prim_bif(X) of
1483	true ->
1484	    {primitive,bif};
1485	false ->
1486	    case construct_bif(X) of
1487		true ->
1488		    {constructed,bif};
1489		false ->
1490		    {undefined,user}
1491	    end
1492    end.
1493
1494prim_bif(X) ->
1495    lists:member(X,['INTEGER' ,
1496		    'ENUMERATED',
1497		    'REAL',
1498		    'OBJECT IDENTIFIER',
1499		    'RELATIVE-OID',
1500		    'NULL',
1501		    'BIT STRING' ,
1502		    'OCTET STRING' ,
1503		    'ObjectDescriptor',
1504		    'NumericString',
1505		    'TeletexString',
1506		    'T61String',
1507		    'VideotexString',
1508		    'UTCTime',
1509		    'GeneralizedTime',
1510		    'GraphicString',
1511		    'VisibleString',
1512		    'GeneralString',
1513		    'PrintableString',
1514		    'IA5String',
1515		    'UniversalString',
1516		    'UTF8String',
1517		    'BMPString',
1518		    'ENUMERATED',
1519		    'BOOLEAN']).
1520
1521construct_bif(T) ->
1522    lists:member(T,['SEQUENCE' ,
1523		    'SEQUENCE OF' ,
1524		    'CHOICE' ,
1525		    'SET' ,
1526		    'SET OF']).
1527
1528def_to_tag(#tag{class=Class,number=Number}) ->
1529    {Class,Number};
1530def_to_tag(#'ObjectClassFieldType'{type=Type}) ->
1531   case Type of
1532       T when is_tuple(T),element(1,T)==fixedtypevaluefield ->
1533	   {'UNIVERSAL',get_inner(Type)};
1534       _ ->
1535	   []
1536   end;
1537def_to_tag(Def) ->
1538    {'UNIVERSAL',get_inner(Def)}.
1539
1540
1541%% Information Object Class
1542
1543get_fieldtype([],_FieldName)->
1544    {no_type,no_name};
1545get_fieldtype([Field|Rest],FieldName) ->
1546    case element(2,Field) of
1547	FieldName ->
1548	    case element(1,Field) of
1549		fixedtypevaluefield ->
1550		    {element(1,Field),FieldName,element(3,Field)};
1551		_ ->
1552		    {element(1,Field),FieldName}
1553	    end;
1554	_  ->
1555	    get_fieldtype(Rest,FieldName)
1556    end.
1557
1558%% Information Object Class
1559
1560%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1561%% Convert a list of name parts to something that can be output by emit
1562%%
1563%% used to output function names in generated code.
1564
1565
1566list2name(L) ->
1567    NewL = list2name1(L),
1568    lists:concat(lists:reverse(NewL)).
1569
1570list2name1([{ptype,H1},H2|T]) ->
1571    [H1,"_",list2name([H2|T])];
1572list2name1([H1,H2|T]) ->
1573    [H1,"_",list2name([H2|T])];
1574list2name1([{ptype,H}|_T]) ->
1575    [H];
1576list2name1([H|_T]) ->
1577    [H];
1578list2name1(H) ->
1579    H.
1580
1581
1582%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1583%% Convert a list of name parts to something that can be output by emit
1584%% stops at {ptype,Pname} i.e Pname whill be the first part of the name
1585%% used to output record names in generated code.
1586
1587list2rname(L) ->
1588    NewL = list2rname1(L),
1589    lists:concat(lists:reverse(NewL)).
1590
1591list2rname1([{ptype,H1},_H2|_T]) ->
1592    [H1];
1593list2rname1([H1,H2|T]) ->
1594    [H1,"_",list2name([H2|T])];
1595list2rname1([{ptype,H}|_T]) ->
1596    [H];
1597list2rname1([H|_T]) ->
1598    [H];
1599list2rname1([]) ->
1600    [].
1601
1602%%
1603%% convert a complist to a [Components] or a {Root,Ext} or a {Root,Ext,Ext2}
1604complist_as_tuple(CompList) ->
1605    complist_as_tuple(CompList, [], [], [], root).
1606
1607complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) ->
1608    complist_as_tuple(T, Acc, Ext, Acc2, ext);
1609complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) ->
1610    complist_as_tuple(T, Acc, Ext, Acc2, root2);
1611complist_as_tuple([C|T], Acc, Ext, Acc2, root) ->
1612    complist_as_tuple(T, [C|Acc], Ext, Acc2, root);
1613complist_as_tuple([C|T], Acc, Ext, Acc2, ext) ->
1614    complist_as_tuple(T, Acc, [C|Ext], Acc2, ext);
1615complist_as_tuple([C|T], Acc, Ext, Acc2, root2) ->
1616    complist_as_tuple(T, Acc, Ext, [C|Acc2], root2);
1617complist_as_tuple([], Acc, _Ext, _Acc2, root) ->
1618    lists:reverse(Acc);
1619complist_as_tuple([], Acc, Ext, _Acc2, ext) ->
1620    {lists:reverse(Acc),lists:reverse(Ext)};
1621complist_as_tuple([], Acc, Ext, Acc2, root2) ->
1622    {lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}.
1623
1624
1625constructed_suffix(_,#'SEQUENCE'{pname=Ptypename}) when Ptypename =/= false ->
1626    {ptype, Ptypename};
1627constructed_suffix(_,#'SET'{pname=Ptypename}) when Ptypename =/= false ->
1628    {ptype,Ptypename};
1629constructed_suffix('SEQUENCE OF',_) ->
1630    'SEQOF';
1631constructed_suffix('SET OF',_) ->
1632    'SETOF'.
1633
1634index2suffix(0) ->
1635    "";
1636index2suffix(N) ->
1637    lists:concat(["_",N]).
1638
1639ct_gen_module(#gen{erule=ber}) ->
1640    asn1ct_gen_ber_bin_v2;
1641ct_gen_module(#gen{erule=per}) ->
1642    asn1ct_gen_per;
1643ct_gen_module(#gen{erule=jer}) ->
1644    asn1ct_gen_jer.
1645
1646
1647ct_constructed_module(#gen{erule=ber}) ->
1648    asn1ct_constructed_ber_bin_v2;
1649ct_constructed_module(#gen{erule=jer}) ->
1650    asn1ct_gen_jer;
1651ct_constructed_module(#gen{erule=per}) ->
1652    asn1ct_constructed_per.
1653
1654get_constraint(C,Key) ->
1655    case lists:keysearch(Key,1,C) of
1656	false ->
1657	     no;
1658	{value,{_,V}} ->
1659	    V;
1660	{value,Cnstr} ->
1661	    Cnstr
1662    end.
1663
1664get_record_name_prefix(#gen{rec_prefix=Prefix}) ->
1665    Prefix.
1666
1667get_macro_name_prefix(#gen{macro_prefix=Prefix}) ->
1668    Prefix.
1669