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