~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%% ``The contents of this file are subject to the Erlang Public License,
 
2
%% Version 1.1, (the "License"); you may not use this file except in
 
3
%% compliance with the License. You should have received a copy of the
 
4
%% Erlang Public License along with this software. If not, it can be
 
5
%% retrieved via the world wide web at http://www.erlang.org/.
 
6
%% 
 
7
%% Software distributed under the License is distributed on an "AS IS"
 
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
9
%% the License for the specific language governing rights and limitations
 
10
%% under the License.
 
11
%% 
 
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
14
%% AB. All Rights Reserved.''
 
15
%% 
 
16
%%     $Id: asn1ct_gen.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $
 
17
%%
 
18
-module(asn1ct_gen).
 
19
 
 
20
-include("asn1_records.hrl").
 
21
%%-compile(export_all).
 
22
-export([pgen_exports/3,
 
23
         pgen_hrl/4,
 
24
         gen_head/3,
 
25
         demit/1,
 
26
         emit/1,
 
27
         fopen/2,
 
28
         get_inner/1,type/1,def_to_tag/1,prim_bif/1,
 
29
         type_from_object/1,
 
30
         get_typefromobject/1,get_fieldcategory/2,
 
31
         get_classfieldcategory/2,
 
32
         list2name/1,
 
33
         list2rname/1,
 
34
         constructed_suffix/2,
 
35
         unify_if_string/1,
 
36
         gen_check_call/7,
 
37
         get_constraint/2,
 
38
         insert_once/2,
 
39
         rt2ct_suffix/1,rt2ct_suffix/0]).
 
40
-export([pgen/4,pgen_module/5,mk_var/1, un_hyphen_var/1]).
 
41
-export([gen_encode_constructed/4,gen_decode_constructed/4]).
 
42
 
 
43
%% pgen(Erules, Module, TypeOrVal)
 
44
%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module
 
45
%% .hrl file is only generated if necessary
 
46
%% Erules = per | ber | ber_bin | per_bin
 
47
%% Module = atom()
 
48
%% TypeOrVal = {TypeList,ValueList}
 
49
%% TypeList = ValueList = [atom()]
 
50
 
 
51
pgen(OutFile,Erules,Module,TypeOrVal) ->
 
52
    pgen_module(OutFile,Erules,Module,TypeOrVal,true).
 
53
 
 
54
 
 
55
pgen_module(OutFile,Erules,Module,TypeOrVal,Indent) ->
 
56
    put(outfile,OutFile),
 
57
    HrlGenerated = asn1ct_gen:pgen_hrl(Erules,Module,TypeOrVal,Indent),
 
58
    asn1ct_name:start(),
 
59
    ErlFile = lists:concat([OutFile,".erl"]),
 
60
    Fid = asn1ct_gen:fopen(ErlFile,write),
 
61
    put(gen_file_out,Fid),
 
62
    asn1ct_gen:gen_head(Erules,Module,HrlGenerated),
 
63
    pgen_exports(Erules,Module,TypeOrVal),
 
64
    pgen_dispatcher(Erules,Module,TypeOrVal),
 
65
    pgen_info(Erules,Module),
 
66
    pgen_typeorval(wrap_ber(Erules),Module,TypeOrVal),
 
67
    pgen_partial_incomplete_decode(Erules),
 
68
% gen_vars(asn1_db:mod_to_vars(Module)),
 
69
% gen_tag_table(AllTypes),
 
70
    file:close(Fid),
 
71
    io:format("--~p--~n",[{generated,ErlFile}]).
 
72
 
 
73
 
 
74
pgen_typeorval(Erules,Module,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) ->
 
75
    pgen_types(Erules,Module,Types),
 
76
    pgen_values(Erules,Module,Values),
 
77
    pgen_objects(Erules,Module,Objects),
 
78
    pgen_objectsets(Erules,Module,ObjectSets),
 
79
    case catch lists:member(der,get(encoding_options)) of
 
80
        true ->
 
81
            pgen_check_defaultval(Erules,Module);
 
82
        _ -> ok
 
83
    end,
 
84
    pgen_partial_decode(Erules,Module).
 
85
 
 
86
pgen_values(_,_,[]) ->
 
87
    true;
 
88
pgen_values(Erules,Module,[H|T]) ->
 
89
    Valuedef = asn1_db:dbget(Module,H),
 
90
    gen_value(Valuedef),
 
91
    pgen_values(Erules,Module,T).
 
92
 
 
93
pgen_types(_,Module,[]) ->
 
94
    gen_value_match(Module),
 
95
    true;
 
96
pgen_types(Erules,Module,[H|T]) ->
 
97
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
98
                                       rt2ct_suffix(Erules)])),
 
99
    asn1ct_name:clear(),
 
100
    Typedef = asn1_db:dbget(Module,H),
 
101
    Rtmod:gen_encode(Erules,Typedef),
 
102
    asn1ct_name:clear(),
 
103
    Rtmod:gen_decode(Erules,Typedef),
 
104
    pgen_types(Erules,Module,T).
 
105
 
 
106
pgen_objects(_,_,[]) ->
 
107
    true;
 
108
pgen_objects(Erules,Module,[H|T]) ->
 
109
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
110
                                       rt2ct_suffix(Erules)])),
 
111
    asn1ct_name:clear(),
 
112
    Typedef = asn1_db:dbget(Module,H),
 
113
    Rtmod:gen_obj_code(Erules,Module,Typedef),
 
114
    pgen_objects(Erules,Module,T).
 
115
 
 
116
pgen_objectsets(_,_,[]) ->
 
117
    true;
 
118
pgen_objectsets(Erules,Module,[H|T]) ->
 
119
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
120
                                       rt2ct_suffix(Erules)])),
 
121
    asn1ct_name:clear(),
 
122
    TypeDef = asn1_db:dbget(Module,H),
 
123
    Rtmod:gen_objectset_code(Erules,TypeDef),
 
124
    pgen_objectsets(Erules,Module,T).
 
125
 
 
126
pgen_check_defaultval(Erules,Module) ->
 
127
    CheckObjects = ets:tab2list(check_functions),
 
128
    case get(asndebug) of
 
129
        true ->
 
130
            FileName = lists:concat([Module,'.table']),
 
131
            {ok,IoDevice} = file:open(FileName,[write]),
 
132
            Fun =
 
133
                fun(X)->
 
134
                        io:format(IoDevice,"~n~n************~n~n~p~n~n*****"
 
135
                                  "********~n~n",[X]) 
 
136
                end,
 
137
            lists:foreach(Fun,CheckObjects),
 
138
            file:close(IoDevice);
 
139
        _ -> ok
 
140
    end,
 
141
    gen_check_defaultval(Erules,Module,CheckObjects).
 
142
 
 
143
pgen_partial_decode(Erules,Module) ->
 
144
    pgen_partial_inc_dec(Erules,Module),
 
145
    pgen_partial_dec(Erules,Module).
 
146
 
 
147
pgen_partial_inc_dec(Erules,Module) ->
 
148
%    io:format("Start partial incomplete decode gen?~n"),
 
149
    case asn1ct:get_gen_state_field(inc_type_pattern) of
 
150
        undefined ->
 
151
%           io:format("Partial incomplete decode gen not started:�~w~n",[asn1ct:get_gen_state_field(active)]),
 
152
            ok;
 
153
%       [] ->
 
154
%           ok;
 
155
        ConfList -> 
 
156
            PatternLists=lists:map(fun({_,P}) -> P end,ConfList),
 
157
            pgen_partial_inc_dec1(Erules,Module,PatternLists),
 
158
            gen_partial_inc_dec_refed_funcs(Erules)
 
159
    end.
 
160
    
 
161
%% pgen_partial_inc_dec1 generates a function of the toptype in each
 
162
%% of the partial incomplete decoded types.
 
163
pgen_partial_inc_dec1(Erules,Module,[P|Ps]) ->
 
164
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
165
                                       rt2ct_suffix(Erules)])),
 
166
    TopTypeName = asn1ct:partial_inc_dec_toptype(P),
 
167
    TypeDef=asn1_db:dbget(Module,TopTypeName),
 
168
    asn1ct_name:clear(),
 
169
    asn1ct:update_gen_state(namelist,P),
 
170
    asn1ct:update_gen_state(active,true),
 
171
    asn1ct:update_gen_state(prefix,"dec-inc-"),
 
172
    Rtmod:gen_decode(Erules,TypeDef),
 
173
%%    asn1ct:update_gen_state(namelist,tl(P)), %% 
 
174
    gen_dec_part_inner_constr(Erules,TypeDef,[TopTypeName]),
 
175
    pgen_partial_inc_dec1(Erules,Module,Ps);
 
176
pgen_partial_inc_dec1(_,_,[]) ->
 
177
    ok.
 
178
 
 
179
gen_partial_inc_dec_refed_funcs(Erule) when Erule == ber_bin_v2 ->
 
180
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erule),
 
181
                                       rt2ct_suffix(Erule)])),
 
182
    case asn1ct:next_refed_func() of
 
183
        [] ->
 
184
            ok;
 
185
        {#'Externaltypereference'{module=M,type=Name},Pattern} ->
 
186
            TypeDef = asn1_db:dbget(M,Name),
 
187
            asn1ct:update_gen_state(namelist,Pattern),
 
188
            Rtmod:gen_inc_decode(Erule,TypeDef),
 
189
            gen_dec_part_inner_constr(Erule,TypeDef,[Name]),
 
190
            gen_partial_inc_dec_refed_funcs(Erule);
 
191
        _ ->
 
192
            gen_partial_inc_dec_refed_funcs(Erule)
 
193
    end;
 
194
gen_partial_inc_dec_refed_funcs(_) ->
 
195
    ok.
 
196
 
 
197
pgen_partial_dec(_Erules,_Module) ->
 
198
    ok. %%%% implement later
 
199
 
 
200
%% generate code for all inner types that are called from the top type
 
201
%% of the partial incomplete decode
 
202
gen_dec_part_inner_constr(Erules,TypeDef,TypeName) ->
 
203
    Def = TypeDef#typedef.typespec,
 
204
    InnerType = asn1ct_gen:get_inner(Def#type.def),
 
205
    case InnerType of
 
206
        'SET' ->
 
207
            #'SET'{components=Components} = Def#type.def,
 
208
            gen_dec_part_inner_types(Erules,Components,TypeName);
 
209
        %%  Continue generate the inner of each component
 
210
        'SEQUENCE' ->
 
211
            #'SEQUENCE'{components=Components} = Def#type.def,
 
212
            gen_dec_part_inner_types(Erules,Components,TypeName);
 
213
        'CHOICE' ->
 
214
            {_,Components} = Def#type.def,
 
215
            gen_dec_part_inner_types(Erules,Components,TypeName);
 
216
        'SEQUENCE OF' ->
 
217
            %% this and next case must be the last component in the
 
218
            %% partial decode chain here. Not likely that this occur.
 
219
            {_,Type} = Def#type.def,
 
220
            NameSuffix = constructed_suffix(InnerType,Type#type.def),
 
221
            Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
222
                                               rt2ct_suffix(Erules)])),
 
223
            asn1ct_name:clear(),
 
224
            Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type);
 
225
%%          gen_types(Erules,[NameSuffix|Typename],Type);
 
226
        'SET OF' ->
 
227
            {_,Type} = Def#type.def,
 
228
            NameSuffix = constructed_suffix(InnerType,Type#type.def),
 
229
            Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
230
                                               rt2ct_suffix(Erules)])),
 
231
            asn1ct_name:clear(),
 
232
            Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type);
 
233
        _ ->
 
234
            ok
 
235
    end.
 
236
 
 
237
gen_dec_part_inner_types(Erules,[ComponentType|Rest],TypeName) ->
 
238
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
239
                                       rt2ct_suffix(Erules)])),
 
240
    asn1ct_name:clear(),
 
241
    Rtmod:gen_decode(Erules,TypeName,ComponentType),
 
242
    gen_dec_part_inner_types(Erules,Rest,TypeName);
 
243
gen_dec_part_inner_types(Erules,{Comps1,Comps2},TypeName)
 
244
  when list(Comps1),list(Comps2) ->
 
245
    gen_dec_part_inner_types(Erules,Comps1 ++ Comps2,TypeName);
 
246
gen_dec_part_inner_types(_,[],_) ->
 
247
    ok.
 
248
 
 
249
 
 
250
pgen_partial_incomplete_decode(Erule) ->
 
251
    case asn1ct:get_gen_state_field(active) of
 
252
        true ->
 
253
            pgen_partial_incomplete_decode1(Erule),
 
254
            asn1ct:reset_gen_state();
 
255
        _ ->
 
256
            ok
 
257
    end.
 
258
pgen_partial_incomplete_decode1(ber_bin_v2) ->
 
259
    case asn1ct:read_config_data(partial_incomplete_decode) of
 
260
        undefined ->
 
261
            ok;
 
262
        Data ->
 
263
            lists:foreach(fun emit_partial_incomplete_decode/1,Data)
 
264
    end,
 
265
    GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs),
 
266
%    io:format("GeneratedFs :~n~p~n",[GeneratedFs]),
 
267
    gen_part_decode_funcs(GeneratedFs,0);
 
268
pgen_partial_incomplete_decode1(_) -> ok.
 
269
 
 
270
emit_partial_incomplete_decode({FuncName,TopTypeName,Pattern}) ->
 
271
    emit([{asis,FuncName},"(Bytes) ->",nl,
 
272
          "  decode_partial_incomplete(",{asis,TopTypeName},",Bytes,",{asis,Pattern},").",nl]);
 
273
emit_partial_incomplete_decode(D) ->
 
274
    throw({error,{asn1,{"bad data in asn1config file",D}}}).
 
275
 
 
276
gen_part_decode_funcs([Data={Name,_,_,Type}|GeneratedFs],N) ->
 
277
    InnerType = 
 
278
        case Type#type.def of
 
279
            #'ObjectClassFieldType'{type=OCFTType} ->
 
280
                OCFTType;
 
281
            _ ->
 
282
                get_inner(Type#type.def)
 
283
        end,
 
284
    WhatKind = type(InnerType),
 
285
    TypeName=list2name(Name),
 
286
    if
 
287
        N > 0 -> emit([";",nl]);
 
288
        true -> ok
 
289
    end,
 
290
    emit(["decode_inc_disp('",TypeName,"',Data) ->",nl]),
 
291
    gen_part_decode_funcs(WhatKind,TypeName,Data),
 
292
    gen_part_decode_funcs(GeneratedFs,N+1);
 
293
gen_part_decode_funcs([_H|T],N) ->
 
294
    gen_part_decode_funcs(T,N);
 
295
gen_part_decode_funcs([],N) ->
 
296
    if
 
297
        N > 0 ->
 
298
            .emit([".",nl]);
 
299
        true ->
 
300
            ok
 
301
    end.
 
302
 
 
303
gen_part_decode_funcs(#'Externaltypereference'{module=M,type=T},
 
304
                      _TypeName,Data) ->
 
305
    #typedef{typespec=TS} = asn1_db:dbget(M,T),
 
306
    InnerType = 
 
307
        case TS#type.def of
 
308
            #'ObjectClassFieldType'{type=OCFTType} ->
 
309
                OCFTType;
 
310
            _ ->
 
311
                get_inner(TS#type.def)
 
312
        end,
 
313
    WhatKind = type(InnerType),
 
314
    gen_part_decode_funcs(WhatKind,[T],Data);
 
315
gen_part_decode_funcs({constructed,bif},TypeName,
 
316
                      {_Name,parts,Tag,_Type}) ->
 
317
    emit(["  case Data of",nl,
 
318
          "    L when list(L) ->",nl,
 
319
          "      'dec_",TypeName,"'(lists:map(fun(X)->element(1,?RT_BER:decode(X)) end,L),",{asis,Tag},");",nl,
 
320
          "    _ ->",nl,
 
321
          "      [Res] = 'dec_",TypeName,"'([Data],",{asis,Tag},"),",nl,
 
322
          "      Res",nl,
 
323
          "  end"]);
 
324
gen_part_decode_funcs(WhatKind,_TypeName,{_Name,parts,_Tag,_Type}) ->
 
325
    throw({error,{asn1,{"only SEQUENCE OF/SET OF may have the partial incomplete directive 'parts'.",WhatKind}}});
 
326
gen_part_decode_funcs({constructed,bif},TypeName,
 
327
                      {_Name,undecoded,Tag,_Type}) ->
 
328
    emit(["  'dec_",TypeName,"'(Data,",{asis,Tag},")"]);
 
329
gen_part_decode_funcs({primitive,bif},_TypeName,
 
330
                      {_Name,undecoded,Tag,Type}) ->
 
331
    % Argument no 6 is 0, i.e. bit 6 for primitive encoding.
 
332
    asn1ct_gen_ber_bin_v2:gen_dec_prim(ber_bin_v2,Type,"Data",Tag,[],0,", mandatory, ");
 
333
gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) ->
 
334
    throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}).
 
335
    
 
336
gen_types(Erules,Tname,{RootList,ExtList}) when list(RootList) ->
 
337
    gen_types(Erules,Tname,RootList),
 
338
    gen_types(Erules,Tname,ExtList);
 
339
gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) ->
 
340
    gen_types(Erules,Tname,Rest);
 
341
gen_types(Erules,Tname,[ComponentType|Rest]) ->
 
342
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
343
                                       rt2ct_suffix(Erules)])),
 
344
    asn1ct_name:clear(),
 
345
    Rtmod:gen_encode(Erules,Tname,ComponentType),
 
346
    asn1ct_name:clear(),
 
347
    Rtmod:gen_decode(Erules,Tname,ComponentType),
 
348
    gen_types(Erules,Tname,Rest);
 
349
gen_types(_,_,[]) ->
 
350
    true;
 
351
gen_types(Erules,Tname,Type) when record(Type,type) ->
 
352
    Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules),
 
353
                                       rt2ct_suffix(Erules)])),
 
354
    asn1ct_name:clear(),
 
355
    Rtmod:gen_encode(Erules,Tname,Type),
 
356
    asn1ct_name:clear(),
 
357
    Rtmod:gen_decode(Erules,Tname,Type).
 
358
 
 
359
gen_value_match(Module) ->
 
360
    case get(value_match) of
 
361
        {true,Module} ->
 
362
            emit(["value_match([{Index,Cname}|Rest],Value) ->",nl,
 
363
                  "  Value2 =",nl,
 
364
                  "    case element(Index,Value) of",nl,
 
365
                  "      {Cname,Val2} -> Val2;",nl,
 
366
                  "      X -> X",nl,
 
367
                  "    end,",nl,
 
368
                  "  value_match(Rest,Value2);",nl,
 
369
                  "value_match([],Value) ->",nl,
 
370
                  "  Value.",nl]);
 
371
        _  -> ok
 
372
    end,
 
373
    put(value_match,undefined).
 
374
 
 
375
gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) ->
 
376
    gen_check_func(Name,Type),
 
377
    gen_check_defaultval(Erules,Module,Rest);
 
378
gen_check_defaultval(_,_,[]) ->
 
379
    ok.
 
380
 
 
381
gen_check_func(Name,FType = #type{def=Def}) ->
 
382
    emit({Name,"(V,asn1_DEFAULT) ->",nl,"   true;",nl}),
 
383
    emit({Name,"(V,V) ->",nl,"   true;",nl}),
 
384
    emit({Name,"(V,{_,V}) ->",nl,"   true;",nl}),
 
385
    case Def of
 
386
        {'SEQUENCE OF',Type} ->
 
387
            gen_check_sof(Name,'SEQOF',Type);
 
388
        {'SET OF',Type} ->
 
389
            gen_check_sof(Name,'SETOF',Type);
 
390
        #'SEQUENCE'{components=Components} ->
 
391
            gen_check_sequence(Name,Components);
 
392
        #'SET'{components=Components} ->
 
393
            gen_check_sequence(Name,Components);
 
394
        {'CHOICE',Components} ->
 
395
            gen_check_choice(Name,Components);
 
396
        #'Externaltypereference'{type=T} ->
 
397
            emit({Name,"(DefaultValue,Value) ->",nl}),
 
398
            emit({"   ",list2name([T,check]),"(DefaultValue,Value).",nl});
 
399
        MaybePrim ->
 
400
            InnerType = get_inner(MaybePrim),
 
401
            case type(InnerType) of
 
402
                {primitive,bif} ->
 
403
                    emit({Name,"(DefaultValue,Value) ->",nl,"   "}),
 
404
                    gen_prim_check_call(InnerType,"DefaultValue","Value",
 
405
                                        FType),
 
406
                    emit({".",nl,nl});
 
407
                _ ->
 
408
                    throw({asn1_error,{unknown,type,MaybePrim}})
 
409
            end
 
410
    end.
 
411
 
 
412
gen_check_sof(Name,SOF,Type) ->
 
413
    NewName = list2name([sorted,Name]),
 
414
    emit({Name,"(V1,V2) ->",nl}),
 
415
    emit({"   ",NewName,"(lists:sort(V1),lists:sort(V2)).",nl,nl}),
 
416
    emit({NewName,"([],[]) ->",nl,"   true;",nl}),
 
417
    emit({NewName,"([DV|DVs],[V|Vs]) ->",nl,"   "}),
 
418
    InnerType = get_inner(Type#type.def),
 
419
    case type(InnerType) of
 
420
        {primitive,bif} ->
 
421
            gen_prim_check_call(InnerType,"DV","V",Type),
 
422
            emit({",",nl});
 
423
        {constructed,bif} ->
 
424
            emit({list2name([SOF,Name]),"(DV, V),",nl});
 
425
        #'Externaltypereference'{type=T} ->
 
426
            emit({list2name([T,check]),"(DV,V),",nl})
 
427
    end,
 
428
    emit({"   ",NewName,"(DVs,Vs).",nl,nl}).
 
429
 
 
430
gen_check_sequence(Name,Components) ->
 
431
    emit({Name,"(DefaultValue,Value) ->",nl}),
 
432
    gen_check_sequence(Name,Components,1).
 
433
gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) ->
 
434
    InnerType = get_inner(Type#type.def),
 
435
%    NthDefV = lists:concat(["lists:nth(",Num,",DefaultValue)"]),
 
436
    NthDefV = ["element(",Num+1,",DefaultValue)"],
 
437
%    NthV = lists:concat(["lists:nth(",Num,",Value)"]),
 
438
    NthV = ["element(",Num+1,",Value)"],
 
439
    gen_check_func_call(Name,Type,InnerType,NthDefV,NthV,N),
 
440
    case Cs of
 
441
        [] ->
 
442
            emit({".",nl,nl});
 
443
        _ ->
 
444
            emit({",",nl}),
 
445
            gen_check_sequence(Name,Cs,Num+1)
 
446
    end;
 
447
gen_check_sequence(_,[],_) ->
 
448
    ok.
 
449
 
 
450
gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) ->
 
451
    emit({Name,"({Id,DefaultValue},{Id,Value}) ->",nl}),
 
452
    emit({"   case Id of",nl}),
 
453
    gen_check_choice_components(Name,CList,1).
 
454
 
 
455
gen_check_choice_components(_,[],_)->
 
456
    ok;
 
457
gen_check_choice_components(Name,[#'ComponentType'{name=N,typespec=Type}|
 
458
                                  Cs],Num) ->
 
459
    Ind6 = "      ",
 
460
    InnerType = get_inner(Type#type.def),
 
461
%    DefVal = ["element(2,lists:nth(",Num,",DefaultValue))"],
 
462
    emit({Ind6,N," ->",nl,Ind6}),
 
463
    gen_check_func_call(Name,Type,InnerType,{var,"defaultValue"},
 
464
                        {var,"value"},N),
 
465
    case Cs of
 
466
        [] ->
 
467
            emit({nl,"   end.",nl,nl});
 
468
        _ ->
 
469
            emit({";",nl}),
 
470
            gen_check_choice_components(Name,Cs,Num+1)
 
471
    end.
 
472
 
 
473
gen_check_func_call(Name,Type,InnerType,DefVal,Val,N) ->
 
474
    case type(InnerType) of
 
475
        {primitive,bif} ->
 
476
            emit("   "),
 
477
            gen_prim_check_call(InnerType,DefVal,Val,Type);
 
478
        #'Externaltypereference'{type=T} ->
 
479
            emit({"   ",list2name([T,check]),"(",DefVal,",",Val,")"});
 
480
        _ ->
 
481
            emit({"   ",list2name([N,Name]),"(",DefVal,",",Val,")"})
 
482
    end.
 
483
                  
 
484
    
 
485
%% VARIOUS GENERATOR STUFF 
 
486
%% *************************************************
 
487
%%**************************************************
 
488
 
 
489
mk_var(X) when atom(X) ->
 
490
    list_to_atom(mk_var(atom_to_list(X)));
 
491
 
 
492
mk_var([H|T]) ->
 
493
    [H-32|T].
 
494
 
 
495
%% Since hyphens are allowed in ASN.1 names, it may occur in a
 
496
%% variable to. Turn a hyphen into a under-score sign.
 
497
un_hyphen_var(X) when atom(X) ->
 
498
    list_to_atom(un_hyphen_var(atom_to_list(X)));
 
499
un_hyphen_var([45|T]) ->
 
500
    [95|un_hyphen_var(T)];
 
501
un_hyphen_var([H|T]) ->
 
502
    [H|un_hyphen_var(T)];
 
503
un_hyphen_var([]) ->
 
504
    [].
 
505
 
 
506
%% Generate value functions ***************
 
507
%% ****************************************
 
508
%% Generates a function 'V'/0 for each Value V defined in the ASN.1 module
 
509
%% the function returns the value in an Erlang representation which can be
 
510
%% used as  input to the runtime encode functions
 
511
 
 
512
gen_value(Value) when record(Value,valuedef) ->
 
513
%%    io:format(" ~w ",[Value#valuedef.name]),
 
514
    emit({"'",Value#valuedef.name,"'() ->",nl}),
 
515
    V = Value#valuedef.value,
 
516
    emit([{asis,V},".",nl,nl]).
 
517
 
 
518
gen_encode_constructed(Erules,Typename,InnerType,D) when record(D,type) ->
 
519
 
 
520
    Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])),
 
521
    case InnerType of
 
522
        'SET' ->
 
523
            Rtmod:gen_encode_set(Erules,Typename,D),
 
524
            #'SET'{components=Components} = D#type.def,
 
525
            gen_types(Erules,Typename,Components);
 
526
        'SEQUENCE' ->
 
527
            Rtmod:gen_encode_sequence(Erules,Typename,D),
 
528
            #'SEQUENCE'{components=Components} = D#type.def,
 
529
            gen_types(Erules,Typename,Components);
 
530
        'CHOICE' ->
 
531
            Rtmod:gen_encode_choice(Erules,Typename,D),
 
532
            {_,Components} = D#type.def,
 
533
            gen_types(Erules,Typename,Components);
 
534
        'SEQUENCE OF' ->
 
535
            Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
 
536
            {_,Type} = D#type.def,
 
537
            NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
 
538
            gen_types(Erules,[NameSuffix|Typename],Type);
 
539
        'SET OF' ->
 
540
            Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
 
541
            {_,Type} = D#type.def,
 
542
            NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
 
543
            gen_types(Erules,[NameSuffix|Typename],Type);
 
544
        _ ->
 
545
            exit({nyi,InnerType})
 
546
    end;
 
547
gen_encode_constructed(Erules,Typename,InnerType,D) 
 
548
  when record(D,typedef) ->
 
549
    gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec).
 
550
 
 
551
gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,type) ->
 
552
    Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])),
 
553
    asn1ct:step_in_constructed(), %% updates namelist for incomplete
 
554
                                  %% partial decode
 
555
    case InnerType of
 
556
        'SET' ->
 
557
            Rtmod:gen_decode_set(Erules,Typename,D);
 
558
        'SEQUENCE' ->
 
559
            Rtmod:gen_decode_sequence(Erules,Typename,D);
 
560
        'CHOICE' ->
 
561
            Rtmod:gen_decode_choice(Erules,Typename,D);
 
562
        'SEQUENCE OF' ->
 
563
            Rtmod:gen_decode_sof(Erules,Typename,InnerType,D);
 
564
        'SET OF' ->
 
565
            Rtmod:gen_decode_sof(Erules,Typename,InnerType,D);
 
566
        _ ->
 
567
            exit({nyi,InnerType})
 
568
    end;
 
569
 
 
570
 
 
571
gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,typedef) ->
 
572
    gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec).
 
573
 
 
574
 
 
575
pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) ->
 
576
    emit({"-export([encoding_rule/0]).",nl}),
 
577
    case Types of
 
578
        [] -> ok;
 
579
        _ ->
 
580
            emit({"-export([",nl}),
 
581
            case Erules of
 
582
                ber ->
 
583
                    gen_exports1(Types,"enc_",2);
 
584
                ber_bin ->
 
585
                    gen_exports1(Types,"enc_",2);
 
586
                ber_bin_v2 ->
 
587
                    gen_exports1(Types,"enc_",2);
 
588
                _ ->
 
589
                    gen_exports1(Types,"enc_",1)
 
590
            end,
 
591
            emit({"-export([",nl}),
 
592
            gen_exports1(Types,"dec_",2),
 
593
            case Erules of
 
594
                ber ->
 
595
                    emit({"-export([",nl}),
 
596
                    gen_exports1(Types,"dec_",3);
 
597
                ber_bin ->
 
598
                    emit({"-export([",nl}),
 
599
                    gen_exports1(Types,"dec_",3);
 
600
                ber_bin_v2 ->
 
601
                    emit({"-export([",nl}),
 
602
                    gen_exports1(Types,"dec_",2);
 
603
                _ -> ok
 
604
            end
 
605
    end,
 
606
    case Values of
 
607
        [] -> ok;
 
608
        _ ->
 
609
            emit({"-export([",nl}),
 
610
            gen_exports1(Values,"",0)
 
611
    end,
 
612
    case Objects of
 
613
        [] -> ok;
 
614
        _ ->
 
615
            case erule(Erules) of
 
616
                per ->
 
617
                    emit({"-export([",nl}),
 
618
                    gen_exports1(Objects,"enc_",3),
 
619
                    emit({"-export([",nl}),
 
620
                    gen_exports1(Objects,"dec_",4);
 
621
                ber_bin_v2 ->
 
622
                    emit({"-export([",nl}),
 
623
                    gen_exports1(Objects,"enc_",3),
 
624
                    emit({"-export([",nl}),
 
625
                    gen_exports1(Objects,"dec_",3);
 
626
                _ -> 
 
627
                    emit({"-export([",nl}),
 
628
                    gen_exports1(Objects,"enc_",4),
 
629
                    emit({"-export([",nl}),
 
630
                    gen_exports1(Objects,"dec_",4)
 
631
            end
 
632
    end,
 
633
    case ObjectSets of
 
634
        [] -> ok;
 
635
        _ ->
 
636
            emit({"-export([",nl}),
 
637
            gen_exports1(ObjectSets,"getenc_",2),
 
638
            emit({"-export([",nl}),
 
639
            gen_exports1(ObjectSets,"getdec_",2)
 
640
    end,
 
641
    emit({"-export([info/0]).",nl}),
 
642
    gen_partial_inc_decode_exports(),
 
643
    emit({nl,nl}).
 
644
 
 
645
gen_exports1([F1,F2|T],Prefix,Arity) ->
 
646
        emit({"'",Prefix,F1,"'/",Arity,com,nl}),
 
647
        gen_exports1([F2|T],Prefix,Arity);
 
648
gen_exports1([Flast|_T],Prefix,Arity) ->
 
649
        emit({"'",Prefix,Flast,"'/",Arity,nl,"]).",nl,nl}).
 
650
 
 
651
gen_partial_inc_decode_exports() ->
 
652
    case {asn1ct:read_config_data(partial_incomplete_decode),
 
653
          asn1ct:get_gen_state_field(inc_type_pattern)}  of
 
654
        {undefined,_} ->
 
655
            ok;
 
656
        {_,undefined} ->
 
657
            ok;
 
658
        {Data,_} ->
 
659
            gen_partial_inc_decode_exports(Data),
 
660
            emit("-export([decode_part/2]).")
 
661
    end.
 
662
gen_partial_inc_decode_exports([]) ->
 
663
    ok;
 
664
gen_partial_inc_decode_exports([{Name,_,_}|Rest]) ->
 
665
    emit(["-export([",Name,"/1"]),
 
666
    gen_partial_inc_decode_exports1(Rest);
 
667
gen_partial_inc_decode_exports([_|Rest]) ->
 
668
    gen_partial_inc_decode_exports(Rest).
 
669
 
 
670
gen_partial_inc_decode_exports1([]) ->
 
671
    emit(["]).",nl]);
 
672
gen_partial_inc_decode_exports1([{Name,_,_}|Rest]) ->
 
673
    emit([", ",Name,"/1"]),
 
674
    gen_partial_inc_decode_exports1(Rest);
 
675
gen_partial_inc_decode_exports1([_|Rest]) ->
 
676
    gen_partial_inc_decode_exports1(Rest).
 
677
 
 
678
pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) ->
 
679
    emit(["encoding_rule() ->",nl]),
 
680
    emit([{asis,Erules},".",nl,nl]);
 
681
pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) ->
 
682
    emit(["-export([encode/2,decode/2,encode_disp/2,decode_disp/2]).",nl,nl]),
 
683
    emit(["encoding_rule() ->",nl]),
 
684
    emit(["   ",{asis,Erules},".",nl,nl]),
 
685
    Call = case Erules of
 
686
               per -> "?RT_PER:complete(encode_disp(Type,Data))";
 
687
               per_bin -> "?RT_PER:complete(encode_disp(Type,Data))";
 
688
               ber -> "encode_disp(Type,Data)";
 
689
               ber_bin -> "encode_disp(Type,Data)";
 
690
               ber_bin_v2 -> "encode_disp(Type,Data)"
 
691
           end,
 
692
    EncWrap = case Erules of
 
693
               ber -> "wrap_encode(Bytes)";
 
694
               _ -> "Bytes"
 
695
           end,
 
696
    emit(["encode(Type,Data) ->",nl,
 
697
          "case catch ",Call," of",nl,
 
698
          "  {'EXIT',{error,Reason}} ->",nl,
 
699
          "    {error,Reason};",nl,
 
700
          "  {'EXIT',Reason} ->",nl,
 
701
          "    {error,{asn1,Reason}};",nl,
 
702
          "  {Bytes,_Len} ->",nl,
 
703
          "    {ok,",EncWrap,"};",nl,
 
704
          "  Bytes ->",nl,
 
705
          "    {ok,",EncWrap,"}",nl,
 
706
          "end.",nl,nl]),
 
707
 
 
708
    case Erules of
 
709
        ber_bin_v2 ->
 
710
            emit(["decode(Type,Data0) ->",nl]),
 
711
            emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",driver_parameter(),"),",nl]);
 
712
        _ ->
 
713
            emit(["decode(Type,Data) ->",nl])
 
714
    end,
 
715
    DecWrap = case Erules of
 
716
                  ber -> "wrap_decode(Data)";
 
717
                  _ -> "Data"
 
718
              end,
 
719
        
 
720
    emit(["case catch decode_disp(Type,",DecWrap,") of",nl,
 
721
          "  {'EXIT',{error,Reason}} ->",nl,
 
722
          "    {error,Reason};",nl,
 
723
          "  {'EXIT',Reason} ->",nl,
 
724
          "    {error,{asn1,Reason}};",nl]),
 
725
    case Erules of 
 
726
        ber_bin_v2 ->
 
727
            emit(["  Result ->",nl,
 
728
                  "    {ok,Result}",nl]);
 
729
        _ ->
 
730
            emit(["  {X,_Rest} ->",nl,
 
731
                  "    {ok,X};",nl,
 
732
                  "  {X,_Rest,_Len} ->",nl,
 
733
                  "    {ok,X}",nl])
 
734
    end,
 
735
    emit(["end.",nl,nl]),
 
736
 
 
737
    gen_decode_partial_incomplete(Erules),
 
738
 
 
739
    case Types of
 
740
        [] -> ok;
 
741
        _ ->
 
742
            case Erules of
 
743
                ber ->
 
744
                    gen_dispatcher(Types,"encode_disp","enc_",",[]"),
 
745
                    gen_dispatcher(Types,"decode_disp","dec_",",mandatory");
 
746
                ber_bin ->
 
747
                    gen_dispatcher(Types,"encode_disp","enc_",",[]"),
 
748
                    gen_dispatcher(Types,"decode_disp","dec_",",mandatory");
 
749
                ber_bin_v2 ->
 
750
                    gen_dispatcher(Types,"encode_disp","enc_",""),
 
751
                    gen_dispatcher(Types,"decode_disp","dec_",""),
 
752
                    gen_partial_inc_dispatcher();
 
753
                _PerOrPer_bin -> 
 
754
                    gen_dispatcher(Types,"encode_disp","enc_",""),
 
755
                    gen_dispatcher(Types,"decode_disp","dec_",",mandatory")
 
756
            end,
 
757
            emit([nl])
 
758
    end,
 
759
    case Erules of
 
760
        ber ->
 
761
            gen_wrapper();
 
762
        _ -> ok
 
763
    end,
 
764
    emit({nl,nl}).
 
765
 
 
766
 
 
767
gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin;
 
768
                                           Erule==ber_bin_v2 ->
 
769
    case {asn1ct:read_config_data(partial_incomplete_decode),
 
770
          asn1ct:get_gen_state_field(inc_type_pattern)} of
 
771
        {undefined,_} ->
 
772
            ok;
 
773
        {_,undefined} ->
 
774
            ok;
 
775
        _ ->
 
776
            case Erule of
 
777
                ber_bin_v2 ->
 
778
                    EmitCaseClauses =
 
779
                        fun() ->
 
780
                                emit(["   {'EXIT',{error,Reason}} ->",nl,
 
781
                                      "      {error,Reason};",nl,
 
782
                                      "    {'EXIT',Reason} ->",nl,
 
783
                                      "      {error,{asn1,Reason}};",nl,
 
784
                                      "    Result ->",nl,
 
785
                                      "      {ok,Result}",nl,
 
786
                                      "  end.",nl,nl])
 
787
                        end,
 
788
                    emit(["decode_partial_incomplete(Type,Data0,",
 
789
                          "Pattern) ->",nl]),
 
790
                    emit(["  {Data,_RestBin} =",nl,
 
791
                          "    ?RT_BER:decode_primitive_",
 
792
                          "incomplete(Pattern,Data0),",nl,
 
793
                          "  case catch decode_partial_inc_disp(Type,",
 
794
                          "Data) of",nl]),
 
795
                    EmitCaseClauses(),
 
796
                    emit(["decode_part(Type,Data0) ->",nl,
 
797
                          "  {Data,_RestBin} = ?RT_BER:decode(Data0),",nl,
 
798
                          "  case catch decode_inc_disp(Type,Data) of",nl]),
 
799
                    EmitCaseClauses();
 
800
                _ -> ok % add later
 
801
            end
 
802
    end;
 
803
gen_decode_partial_incomplete(_Erule) ->
 
804
    ok.
 
805
 
 
806
gen_partial_inc_dispatcher() ->
 
807
    case {asn1ct:read_config_data(partial_incomplete_decode),
 
808
          asn1ct:get_gen_state_field(inc_type_pattern)} of
 
809
        {undefined,_} ->
 
810
            ok;
 
811
        {_,undefined} ->
 
812
            ok;
 
813
        {Data,_} ->
 
814
            gen_partial_inc_dispatcher(Data)
 
815
    end.
 
816
gen_partial_inc_dispatcher([{_FuncName,TopType,_Pattern}|Rest]) ->
 
817
    emit(["decode_partial_inc_disp(",{asis,TopType},",Data) ->",nl,
 
818
          "  ",{asis,list_to_atom(lists:concat([dec,"-inc-",TopType]))},
 
819
          "(Data);",nl]),
 
820
    gen_partial_inc_dispatcher(Rest);
 
821
gen_partial_inc_dispatcher([]) ->
 
822
    emit(["decode_partial_inc_disp(Type,_Data) ->",nl,
 
823
          "  exit({error,{asn1,{undefined_type,Type}}}).",nl]).
 
824
 
 
825
driver_parameter() ->
 
826
    Options = get(encoding_options),
 
827
    case lists:member(driver,Options) of
 
828
        true ->
 
829
            ",driver";
 
830
        _ -> ""
 
831
    end.
 
832
 
 
833
gen_wrapper() ->
 
834
    emit(["wrap_encode(Bytes) when list(Bytes) ->",nl,
 
835
          "   binary_to_list(list_to_binary(Bytes));",nl,
 
836
          "wrap_encode(Bytes) when binary(Bytes) ->",nl,
 
837
          "   binary_to_list(Bytes);",nl,
 
838
          "wrap_encode(Bytes) -> Bytes.",nl,nl]),
 
839
    emit(["wrap_decode(Bytes) when list(Bytes) ->",nl,
 
840
          "   list_to_binary(Bytes);",nl,
 
841
          "wrap_decode(Bytes) -> Bytes.",nl]).
 
842
    
 
843
gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) ->
 
844
        emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]),
 
845
        gen_dispatcher([F2|T],FuncName,Prefix,ExtraArg);
 
846
gen_dispatcher([Flast|_T],FuncName,Prefix,ExtraArg) ->
 
847
        emit([FuncName,"('",Flast,"',Data) -> '",Prefix,Flast,"'(Data",ExtraArg,")",";",nl]),
 
848
        emit([FuncName,"(","Type",",_Data) -> exit({error,{asn1,{undefined_type,Type}}}).",nl,nl,nl]).
 
849
 
 
850
pgen_info(_Erules,Module) ->
 
851
    Options = get(encoding_options),
 
852
    emit({"info() ->",nl,
 
853
          "  [{vsn,'",asn1ct:vsn(),"'},",
 
854
          "   {module,'",Module,"'},",
 
855
          "   {options,",io_lib:format("~p",[Options]),"}].",nl}).
 
856
 
 
857
open_hrl(OutFile,Module) ->
 
858
    File = lists:concat([OutFile,".hrl"]),
 
859
    Fid = fopen(File,write),
 
860
    put(gen_file_out,Fid),
 
861
    gen_hrlhead(Module).
 
862
 
 
863
%% EMIT functions ************************
 
864
%% ***************************************
 
865
 
 
866
                                                % debug generation
 
867
demit(Term) ->
 
868
    case get(asndebug) of
 
869
        true -> emit(Term);
 
870
        _ ->true
 
871
    end.
 
872
 
 
873
                                                % always generation
 
874
 
 
875
emit({external,_M,T}) ->
 
876
    emit(T);
 
877
 
 
878
emit({prev,Variable}) when atom(Variable) ->
 
879
    emit({var,asn1ct_name:prev(Variable)});
 
880
 
 
881
emit({next,Variable}) when atom(Variable) ->
 
882
    emit({var,asn1ct_name:next(Variable)});
 
883
 
 
884
emit({curr,Variable}) when atom(Variable) ->
 
885
    emit({var,asn1ct_name:curr(Variable)});
 
886
    
 
887
emit({var,Variable}) when atom(Variable) ->
 
888
    [Head|V] = atom_to_list(Variable),
 
889
    emit([Head-32|V]);
 
890
 
 
891
emit({var,Variable}) ->
 
892
    [Head|V] = Variable,
 
893
    emit([Head-32|V]);
 
894
 
 
895
emit({asis,What}) ->
 
896
    format(get(gen_file_out),"~w",[What]);
 
897
 
 
898
emit(nl) ->
 
899
    nl(get(gen_file_out));
 
900
 
 
901
emit(com) ->
 
902
    emit(",");
 
903
 
 
904
emit(tab) ->
 
905
    put_chars(get(gen_file_out),"     ");
 
906
 
 
907
emit(What) when integer(What) ->
 
908
    put_chars(get(gen_file_out),integer_to_list(What));
 
909
 
 
910
emit(What) when list(What), integer(hd(What)) ->
 
911
    put_chars(get(gen_file_out),What);
 
912
 
 
913
emit(What) when atom(What) ->
 
914
    put_chars(get(gen_file_out),atom_to_list(What));
 
915
 
 
916
emit(What) when tuple(What) ->
 
917
    emit_parts(tuple_to_list(What));
 
918
 
 
919
emit(What) when list(What) ->
 
920
    emit_parts(What);
 
921
 
 
922
emit(X) ->
 
923
    exit({'cant emit ',X}).
 
924
 
 
925
emit_parts([]) -> true;
 
926
emit_parts([H|T]) ->
 
927
    emit(H),
 
928
    emit_parts(T).
 
929
 
 
930
format(undefined,X,Y) ->
 
931
    io:format(X,Y);
 
932
format(X,Y,Z) ->
 
933
    io:format(X,Y,Z).
 
934
 
 
935
nl(undefined) -> io:nl();
 
936
nl(X) -> io:nl(X).
 
937
 
 
938
put_chars(undefined,X) ->
 
939
    io:put_chars(X);
 
940
put_chars(Y,X) ->
 
941
    io:put_chars(Y,X).
 
942
 
 
943
fopen(F, Mode) ->
 
944
    case file:open(F, [Mode]) of
 
945
        {ok, Fd} -> 
 
946
            Fd;
 
947
        {error, Reason} ->
 
948
            io:format("** Can't open file ~p ~n", [F]),
 
949
            exit({error,Reason})
 
950
    end.
 
951
 
 
952
pgen_hrl(Erules,Module,TypeOrVal,_Indent) ->
 
953
    put(currmod,Module),
 
954
    {Types,Values,Ptypes,_,_,_} = TypeOrVal,
 
955
    Ret =
 
956
        case pgen_hrltypes(Erules,Module,Ptypes++Types,0) of
 
957
            0 -> 
 
958
                case Values of
 
959
                    [] ->
 
960
                        0;
 
961
                    _ ->
 
962
                        open_hrl(get(outfile),get(currmod)),
 
963
                        pgen_macros(Erules,Module,Values),
 
964
                        1
 
965
                end;
 
966
            X ->
 
967
                pgen_macros(Erules,Module,Values),
 
968
                X
 
969
        end,
 
970
    case Ret of
 
971
        0 ->
 
972
            0;
 
973
        Y ->
 
974
            Fid = get(gen_file_out),
 
975
            file:close(Fid),
 
976
            io:format("--~p--~n",
 
977
                      [{generated,lists:concat([get(outfile),".hrl"])}]),
 
978
            Y
 
979
    end.
 
980
 
 
981
pgen_macros(_,_,[]) ->
 
982
    true;
 
983
pgen_macros(Erules,Module,[H|T]) ->
 
984
    Valuedef = asn1_db:dbget(Module,H),
 
985
    gen_macro(Valuedef),
 
986
    pgen_macros(Erules,Module,T).
 
987
 
 
988
pgen_hrltypes(_,_,[],NumRecords) ->
 
989
    NumRecords;
 
990
pgen_hrltypes(Erules,Module,[H|T],NumRecords) ->
 
991
%    io:format("records = ~p~n",NumRecords),
 
992
    Typedef = asn1_db:dbget(Module,H),
 
993
    AddNumRecords = gen_record(Typedef,NumRecords),
 
994
    pgen_hrltypes(Erules,Module,T,NumRecords+AddNumRecords).
 
995
 
 
996
 
 
997
%% Generates a macro for value Value defined in the ASN.1 module
 
998
gen_macro(Value) when record(Value,valuedef) ->
 
999
    emit({"-define('",Value#valuedef.name,"', ",
 
1000
          {asis,Value#valuedef.value},").",nl}).
 
1001
 
 
1002
%% Generate record functions **************
 
1003
%% Generates an Erlang record for each named and unnamed SEQUENCE and SET in the ASN.1 
 
1004
%% module. If no SEQUENCE or SET is found there is no .hrl file generated
 
1005
 
 
1006
 
 
1007
gen_record(Tdef,NumRecords) when record(Tdef,typedef) ->
 
1008
    Name = [Tdef#typedef.name],
 
1009
    Type = Tdef#typedef.typespec,
 
1010
    gen_record(type,Name,Type,NumRecords);
 
1011
 
 
1012
gen_record(Tdef,NumRecords) when record(Tdef,ptypedef) ->
 
1013
    Name = [Tdef#ptypedef.name],
 
1014
    Type = Tdef#ptypedef.typespec,
 
1015
    gen_record(ptype,Name,Type,NumRecords).
 
1016
    
 
1017
gen_record(TorPtype,Name,[#'ComponentType'{name=Cname,typespec=Type}|T],Num) ->
 
1018
    Num2 = gen_record(TorPtype,[Cname|Name],Type,Num),
 
1019
    gen_record(TorPtype,Name,T,Num2);
 
1020
gen_record(TorPtype,Name,{Clist1,Clist2},Num) when list(Clist1), list(Clist2) ->
 
1021
    gen_record(TorPtype,Name,Clist1++Clist2,Num);
 
1022
gen_record(TorPtype,Name,[_|T],Num) -> % skip EXTENSIONMARK
 
1023
    gen_record(TorPtype,Name,T,Num);
 
1024
gen_record(_TorPtype,_Name,[],Num) ->
 
1025
    Num;
 
1026
 
 
1027
gen_record(TorPtype,Name,Type,Num) when record(Type,type) ->    
 
1028
    Def = Type#type.def,
 
1029
    Rec = case Def of
 
1030
              Seq when record(Seq,'SEQUENCE') ->
 
1031
                  case Seq#'SEQUENCE'.pname of
 
1032
                      false ->
 
1033
                          {record,Seq#'SEQUENCE'.components};
 
1034
                      _Pname when TorPtype == type ->
 
1035
                          false;
 
1036
                      _ ->
 
1037
                          {record,Seq#'SEQUENCE'.components}
 
1038
                  end;
 
1039
              Set when record(Set,'SET') ->
 
1040
                  case Set#'SET'.pname of
 
1041
                      false ->
 
1042
                          {record,Set#'SET'.components};
 
1043
                      _Pname when TorPtype == type ->
 
1044
                          false;
 
1045
                      _ ->
 
1046
                          {record,Set#'SET'.components}
 
1047
                  end;
 
1048
%             {'SET',{_,_CompList}} -> 
 
1049
%                 {record,_CompList}; 
 
1050
              {'CHOICE',_CompList} -> {inner,Def};
 
1051
              {'SEQUENCE OF',_CompList} -> {['SEQOF'|Name],Def};
 
1052
              {'SET OF',_CompList} -> {['SETOF'|Name],Def};
 
1053
              _ -> false
 
1054
    end,
 
1055
    case Rec of
 
1056
        false -> Num;
 
1057
        {record,CompList} ->
 
1058
            case Num of
 
1059
                0 -> open_hrl(get(outfile),get(currmod));
 
1060
                _ -> true
 
1061
            end,
 
1062
            emit({"-record('",list2name(Name),"',{",nl}),
 
1063
            RootList = case CompList of
 
1064
                           _ when list(CompList) ->
 
1065
                               CompList;
 
1066
                           {_Rl,_} -> _Rl
 
1067
                       end,
 
1068
            gen_record2(Name,'SEQUENCE',RootList),
 
1069
            NewCompList = 
 
1070
                case CompList of
 
1071
                    {CompList1,[]} ->
 
1072
                        emit({"}). % with extension mark",nl,nl}),
 
1073
                        CompList1;
 
1074
                    {Tr,ExtensionList2} ->
 
1075
                        case Tr of
 
1076
                            [] -> true;
 
1077
                            _ -> emit({",",nl})
 
1078
                        end,
 
1079
                        emit({"%% with extensions",nl}),
 
1080
                        gen_record2(Name, 'SEQUENCE', ExtensionList2,
 
1081
                                    "", ext),
 
1082
                        emit({"}).",nl,nl}),
 
1083
                        Tr ++ ExtensionList2;
 
1084
                    _ -> 
 
1085
                        emit({"}).",nl,nl}),
 
1086
                        CompList
 
1087
                end,
 
1088
            gen_record(TorPtype,Name,NewCompList,Num+1);
 
1089
        {inner,{'CHOICE', CompList}} ->
 
1090
            gen_record(TorPtype,Name,CompList,Num);
 
1091
        {NewName,{_, CompList}} ->
 
1092
            gen_record(TorPtype,NewName,CompList,Num)
 
1093
    end;
 
1094
gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now.
 
1095
     NumRecords.
 
1096
                    
 
1097
gen_head(Erules,Mod,Hrl) ->
 
1098
    {Rtmac,Rtmod} = case Erules of
 
1099
                        per ->
 
1100
                            emit({"%% Generated by the Erlang ASN.1 PER-"
 
1101
                                  "compiler version:",asn1ct:vsn(),nl}),
 
1102
                            {"RT_PER",?RT_PER};
 
1103
                        ber ->
 
1104
                            emit({"%% Generated by the Erlang ASN.1 BER-"
 
1105
                                  "compiler version:",asn1ct:vsn(),nl}),
 
1106
                            {"RT_BER",?RT_BER_BIN};
 
1107
                        per_bin ->
 
1108
                            emit({"%% Generated by the Erlang ASN.1 BER-"
 
1109
                                  "compiler version, utilizing bit-syntax:",
 
1110
                                  asn1ct:vsn(),nl}),
 
1111
                            %% temporary code to enable rt2ct optimization
 
1112
                            Options = get(encoding_options),
 
1113
                            case lists:member(optimize,Options) of
 
1114
                                true -> {"RT_PER","asn1rt_per_bin_rt2ct"};
 
1115
                                _ ->
 
1116
                                    {"RT_PER",?RT_PER_BIN}
 
1117
                            end;
 
1118
                        ber_bin ->
 
1119
                            emit({"%% Generated by the Erlang ASN.1 BER-"
 
1120
                                  "compiler version, utilizing bit-syntax:",
 
1121
                                  asn1ct:vsn(),nl}),
 
1122
                            {"RT_BER",?RT_BER_BIN};
 
1123
                        ber_bin_v2 ->
 
1124
                            emit({"%% Generated by the Erlang ASN.1 BER_V2-"
 
1125
                                  "compiler version, utilizing bit-syntax:",
 
1126
                                  asn1ct:vsn(),nl}),
 
1127
                            {"RT_BER","asn1rt_ber_bin_v2"}
 
1128
    end,
 
1129
    emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}),
 
1130
    emit({"-module('",Mod,"').",nl}),
 
1131
    put(currmod,Mod),
 
1132
    %emit({"-compile(export_all).",nl}),
 
1133
    case Hrl of
 
1134
        0 -> true;
 
1135
        _ -> 
 
1136
            emit({"-include(\"",Mod,".hrl\").",nl})
 
1137
    end,
 
1138
    emit(["-define('",Rtmac,"',",Rtmod,").",nl]).
 
1139
                        
 
1140
 
 
1141
gen_hrlhead(Mod) ->
 
1142
    emit({"%% Generated by the Erlang ASN.1 compiler version:",asn1ct:vsn(),nl}),
 
1143
    emit({"%% Purpose: Erlang record definitions for each named and unnamed",nl}),
 
1144
    emit({"%% SEQUENCE and SET, and macro definitions for each value",nl}),
 
1145
    emit({"%% definition,in module ",Mod,nl,nl}),
 
1146
    emit({nl,nl}).
 
1147
 
 
1148
gen_record2(Name,SeqOrSet,Comps) ->
 
1149
    gen_record2(Name,SeqOrSet,Comps,"",noext).
 
1150
 
 
1151
gen_record2(_Name,_SeqOrSet,[],_Com,_Extension) ->
 
1152
    true;
 
1153
gen_record2(Name,SeqOrSet,[{'EXTENSIONMARK',_,_}|T],Com,Extension) ->
 
1154
    gen_record2(Name,SeqOrSet,T,Com,Extension);
 
1155
gen_record2(_Name,_SeqOrSet,[H],Com,Extension) ->
 
1156
    #'ComponentType'{name=Cname} = H,
 
1157
    emit(Com),
 
1158
    emit({asis,Cname}),
 
1159
    gen_record_default(H, Extension);
 
1160
gen_record2(Name,SeqOrSet,[H|T],Com, Extension) ->
 
1161
    #'ComponentType'{name=Cname} = H,
 
1162
    emit(Com),
 
1163
    emit({asis,Cname}),
 
1164
    gen_record_default(H, Extension),
 
1165
%    emit(", "),
 
1166
    gen_record2(Name,SeqOrSet,T,", ", Extension).
 
1167
 
 
1168
%gen_record_default(C, ext) ->
 
1169
%    emit(" = asn1_NOEXTVALUE");
 
1170
gen_record_default(#'ComponentType'{prop='OPTIONAL'}, _)->
 
1171
    emit(" = asn1_NOVALUE"); 
 
1172
gen_record_default(#'ComponentType'{prop={'DEFAULT',_}}, _)->
 
1173
    emit(" = asn1_DEFAULT"); 
 
1174
gen_record_default(_, _) ->
 
1175
    true.
 
1176
 
 
1177
gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) ->
 
1178
    case WhatKind of
 
1179
        {primitive,bif} ->
 
1180
            gen_prim_check_call(InnerType,DefaultValue,Element,Type);
 
1181
        #'Externaltypereference'{module=M,type=T} ->
 
1182
            %% generate function call
 
1183
            Name = list2name([T,check]),
 
1184
            emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
 
1185
            %% insert in ets table and do look ahead check
 
1186
            Typedef = asn1_db:dbget(M,T),
 
1187
            RefType = Typedef#typedef.typespec,
 
1188
            InType = asn1ct_gen:get_inner(RefType#type.def),
 
1189
            case insert_once(check_functions,{Name,RefType}) of
 
1190
                true ->
 
1191
                    lookahead_innertype([T],InType,RefType);
 
1192
%                   case asn1ct_gen:type(InType) of
 
1193
%                       {constructed,bif} ->
 
1194
%                           lookahead_innertype([T],InType,RefType);
 
1195
%                       #'Externaltypereference'{type=TNew} ->
 
1196
%                           lookahead_innertype([TNew],InType,RefType);
 
1197
%                       _ ->
 
1198
%                           ok
 
1199
%                   end;
 
1200
                _ ->
 
1201
                    ok
 
1202
            end;
 
1203
        {constructed,bif} ->
 
1204
            NameList = [Cname|TopType],
 
1205
            Name = list2name(NameList ++ [check]),
 
1206
            emit({"'",Name,"'(",DefaultValue,", ",Element,")"}),
 
1207
            ets:insert(check_functions,{Name,Type}),
 
1208
            %% Must look for check functions in InnerType,
 
1209
            %% that may be referenced  or internal defined 
 
1210
            %% constructed types not used elsewhere.
 
1211
            lookahead_innertype(NameList,InnerType,Type)
 
1212
    end.
 
1213
 
 
1214
gen_prim_check_call(PrimType,DefaultValue,Element,Type) ->
 
1215
    case unify_if_string(PrimType) of
 
1216
        'BOOLEAN' ->
 
1217
            emit({"asn1rt_check:check_bool(",DefaultValue,", ",
 
1218
                  Element,")"});
 
1219
        'INTEGER' ->
 
1220
            NNL =
 
1221
                case Type#type.def of
 
1222
                    {_,NamedNumberList} -> NamedNumberList;
 
1223
                    _ -> []
 
1224
                end,
 
1225
            emit({"asn1rt_check:check_int(",DefaultValue,", ",
 
1226
                  Element,", ",{asis,NNL},")"});
 
1227
        'BIT STRING' ->
 
1228
            {_,NBL} = Type#type.def,
 
1229
            emit({"asn1rt_check:check_bitstring(",DefaultValue,", ",
 
1230
                  Element,", ",{asis,NBL},")"});
 
1231
        'OCTET STRING' ->
 
1232
            emit({"asn1rt_check:check_octetstring(",DefaultValue,", ",
 
1233
                  Element,")"});
 
1234
        'NULL' ->
 
1235
            emit({"asn1rt_check:check_null(",DefaultValue,", ",
 
1236
                  Element,")"});
 
1237
        'OBJECT IDENTIFIER' ->
 
1238
            emit({"asn1rt_check:check_objectidentifier(",DefaultValue,
 
1239
                  ", ",Element,")"});
 
1240
        'ObjectDescriptor' ->
 
1241
            emit({"asn1rt_check:check_objectdescriptor(",DefaultValue,
 
1242
                  ", ",Element,")"});
 
1243
        'REAL' ->
 
1244
            emit({"asn1rt_check:check_real(",DefaultValue,
 
1245
                  ", ",Element,")"});
 
1246
        'ENUMERATED' ->
 
1247
            {_,Enumerations} = Type#type.def,
 
1248
            emit({"asn1rt_check:check_enum(",DefaultValue,
 
1249
                  ", ",Element,", ",{asis,Enumerations},")"});
 
1250
        restrictedstring ->
 
1251
            emit({"asn1rt_check:check_restrictedstring(",DefaultValue,
 
1252
                  ", ",Element,")"})
 
1253
    end.
 
1254
 
 
1255
%% lokahead_innertype/3 traverses Type and checks if check functions
 
1256
%% have to be generated, i.e. for all constructed or referenced types.
 
1257
lookahead_innertype(Name,'SEQUENCE',Type) ->
 
1258
    Components = (Type#type.def)#'SEQUENCE'.components,
 
1259
    lookahead_components(Name,Components);
 
1260
lookahead_innertype(Name,'SET',Type) ->
 
1261
    Components = (Type#type.def)#'SET'.components,
 
1262
    lookahead_components(Name,Components);
 
1263
lookahead_innertype(Name,'CHOICE',Type) ->
 
1264
    {_,Components} = Type#type.def,
 
1265
    lookahead_components(Name,Components);
 
1266
lookahead_innertype(Name,'SEQUENCE OF',SeqOf) ->
 
1267
    lookahead_sof(Name,'SEQOF',SeqOf);
 
1268
lookahead_innertype(Name,'SET OF',SeqOf) ->
 
1269
    lookahead_sof(Name,'SETOF',SeqOf);
 
1270
lookahead_innertype(_Name,#'Externaltypereference'{module=M,type=T},_) ->
 
1271
    Typedef = asn1_db:dbget(M,T),
 
1272
    RefType = Typedef#typedef.typespec,
 
1273
    InType = asn1ct_gen:get_inner(RefType#type.def),
 
1274
    case type(InType) of
 
1275
        {constructed,bif} ->
 
1276
            NewName = list2name([T,check]),
 
1277
            case insert_once(check_functions,{NewName,RefType}) of
 
1278
                true ->
 
1279
                    lookahead_innertype([T],InType,RefType);
 
1280
                _ ->
 
1281
                    ok
 
1282
            end;
 
1283
        #'Externaltypereference'{} ->
 
1284
            NewName = list2name([T,check]),
 
1285
            case insert_once(check_functions,{NewName,RefType}) of
 
1286
                true ->
 
1287
                    lookahead_innertype([T],InType,RefType);
 
1288
                _ ->
 
1289
                    ok
 
1290
            end;
 
1291
        _ ->
 
1292
            ok
 
1293
    end;
 
1294
%    case insert_once(check_functions,{list2name(Name++[check]),Type}) of
 
1295
%       true ->
 
1296
%           InnerType = asn1ct_gen:get_inner(Type#type.def),
 
1297
%           case asn1ct_gen:type(InnerType) of
 
1298
%               {constructed,bif} ->
 
1299
%                   lookahead_innertype([T],InnerType,Type);
 
1300
%               #'Externaltypereference'{type=TNew} ->
 
1301
%                   lookahead_innertype([TNew],InnerType,Type);
 
1302
%               _ ->
 
1303
%                   ok
 
1304
%           end;
 
1305
%       _ ->
 
1306
%           ok
 
1307
%    end;
 
1308
lookahead_innertype(_,_,_) ->
 
1309
    ok.
 
1310
 
 
1311
lookahead_components(_,[]) -> ok;
 
1312
lookahead_components(Name,[C|Cs]) ->
 
1313
    #'ComponentType'{name=Cname,typespec=Type} = C,
 
1314
    InType = asn1ct_gen:get_inner(Type#type.def),
 
1315
    case asn1ct_gen:type(InType) of
 
1316
        {constructed,bif} ->
 
1317
            case insert_once(check_functions,
 
1318
                             {list2name([Cname|Name] ++ [check]),Type}) of
 
1319
                true ->
 
1320
                    lookahead_innertype([Cname|Name],InType,Type);
 
1321
                _ ->
 
1322
                    ok
 
1323
            end;
 
1324
        #'Externaltypereference'{module=RefMod,type=RefName} ->
 
1325
            Typedef = asn1_db:dbget(RefMod,RefName),
 
1326
            RefType = Typedef#typedef.typespec,
 
1327
            case insert_once(check_functions,{list2name([RefName,check]),
 
1328
                                              RefType}) of
 
1329
                true ->
 
1330
                    lookahead_innertype([RefName],InType,RefType);
 
1331
                _ ->
 
1332
                    ok
 
1333
            end;
 
1334
        _ ->
 
1335
            ok
 
1336
    end,
 
1337
    lookahead_components(Name,Cs).
 
1338
 
 
1339
lookahead_sof(Name,SOF,SOFType) ->
 
1340
    Type = case SOFType#type.def of
 
1341
               {_,_Type} -> _Type;
 
1342
               _Type -> _Type
 
1343
           end,
 
1344
    InnerType = asn1ct_gen:get_inner(Type#type.def),
 
1345
    case asn1ct_gen:type(InnerType) of
 
1346
        {constructed,bif} ->
 
1347
            %% this is if a constructed type is defined in
 
1348
            %% the SEQUENCE OF type
 
1349
            NameList = [SOF|Name],
 
1350
            insert_once(check_functions,
 
1351
                        {list2name(NameList ++ [check]),Type}),
 
1352
            lookahead_innertype(NameList,InnerType,Type);
 
1353
        #'Externaltypereference'{module=M,type=T} ->
 
1354
            Typedef = asn1_db:dbget(M,T),
 
1355
            RefType = Typedef#typedef.typespec,
 
1356
            InType = get_inner(RefType#type.def),
 
1357
            case insert_once(check_functions,
 
1358
                             {list2name([T,check]),RefType}) of
 
1359
                true ->
 
1360
                    lookahead_innertype([T],InType,RefType);
 
1361
                _ ->
 
1362
                    ok
 
1363
            end;
 
1364
        _ ->
 
1365
            ok
 
1366
    end.
 
1367
 
 
1368
 
 
1369
insert_once(Table,Object) ->
 
1370
    case ets:lookup(Table,element(1,Object)) of
 
1371
        [] ->
 
1372
            ets:insert(Table,Object); %returns true
 
1373
        _ -> false
 
1374
    end.
 
1375
 
 
1376
unify_if_string(PrimType) ->
 
1377
    case PrimType of
 
1378
        'NumericString' ->
 
1379
            restrictedstring;
 
1380
        'PrintableString' ->
 
1381
            restrictedstring;
 
1382
        'TeletexString' ->
 
1383
            restrictedstring;
 
1384
        'VideotexString' ->
 
1385
            restrictedstring;
 
1386
        'IA5String' ->
 
1387
            restrictedstring;
 
1388
        'UTCTime' ->
 
1389
            restrictedstring;
 
1390
        'GeneralizedTime' ->
 
1391
            restrictedstring;
 
1392
        'GraphicString' ->
 
1393
            restrictedstring;
 
1394
        'VisibleString' ->
 
1395
            restrictedstring;
 
1396
        'GeneralString' ->
 
1397
            restrictedstring;
 
1398
        'UniversalString' ->
 
1399
            restrictedstring;
 
1400
        'BMPString' ->
 
1401
            restrictedstring;
 
1402
        Other -> Other
 
1403
    end.
 
1404
 
 
1405
 
 
1406
        
 
1407
        
 
1408
 
 
1409
get_inner(A) when atom(A) -> A;    
 
1410
get_inner(Ext) when record(Ext,'Externaltypereference') -> Ext;    
 
1411
get_inner(Tref) when record(Tref,typereference) -> Tref;
 
1412
get_inner({fixedtypevaluefield,_,Type}) ->
 
1413
    if 
 
1414
        record(Type,type) ->
 
1415
            get_inner(Type#type.def);
 
1416
        true ->
 
1417
            get_inner(Type)
 
1418
    end;
 
1419
get_inner({typefield,TypeName}) ->
 
1420
    TypeName;
 
1421
get_inner(#'ObjectClassFieldType'{type=Type}) ->
 
1422
%    get_inner(Type);
 
1423
    Type;
 
1424
get_inner(T) when tuple(T) -> 
 
1425
    case element(1,T) of
 
1426
        Tuple when tuple(Tuple),element(1,Tuple) == objectclass ->
 
1427
            case catch(lists:last(element(2,T))) of
 
1428
                {valuefieldreference,FieldName} ->
 
1429
                    get_fieldtype(element(2,Tuple),FieldName);
 
1430
                {typefieldreference,FieldName} ->
 
1431
                    get_fieldtype(element(2,Tuple),FieldName);
 
1432
                {'EXIT',Reason} ->
 
1433
                    throw({asn1,{'internal error in get_inner/1',Reason}})
 
1434
            end;
 
1435
        _ -> element(1,T)
 
1436
    end.
 
1437
 
 
1438
 
 
1439
 
 
1440
 
 
1441
 
 
1442
type(X) when record(X,'Externaltypereference') ->
 
1443
    X;
 
1444
type(X) when record(X,typereference) ->
 
1445
    X;
 
1446
type('ASN1_OPEN_TYPE') ->
 
1447
    'ASN1_OPEN_TYPE';
 
1448
type({fixedtypevaluefield,_Name,Type}) when record(Type,type) ->
 
1449
    type(get_inner(Type#type.def));
 
1450
type({typefield,_}) ->
 
1451
    'ASN1_OPEN_TYPE';
 
1452
type(X) ->
 
1453
    %%    io:format("asn1_types:type(~p)~n",[X]),
 
1454
    case catch type2(X) of
 
1455
        {'EXIT',_} ->
 
1456
            {notype,X};
 
1457
        Normal ->
 
1458
            Normal
 
1459
    end.
 
1460
 
 
1461
type2(X) ->
 
1462
    case prim_bif(X) of
 
1463
        true ->
 
1464
            {primitive,bif};
 
1465
        false ->
 
1466
            case construct_bif(X) of
 
1467
                true ->
 
1468
                    {constructed,bif};
 
1469
                false ->
 
1470
                    {undefined,user}
 
1471
            end
 
1472
    end.
 
1473
 
 
1474
prim_bif(X) ->
 
1475
    lists:member(X,['INTEGER' ,
 
1476
                    'ENUMERATED',
 
1477
                    'OBJECT IDENTIFIER',
 
1478
                    'ANY',
 
1479
                    'NULL',
 
1480
                    'BIT STRING' ,
 
1481
                    'OCTET STRING' ,
 
1482
                    'ObjectDescriptor',
 
1483
                    'NumericString',
 
1484
                    'TeletexString',
 
1485
                    'VideotexString',
 
1486
                    'UTCTime',
 
1487
                    'GeneralizedTime',
 
1488
                    'GraphicString',
 
1489
                    'VisibleString',
 
1490
                    'GeneralString',
 
1491
                    'PrintableString',
 
1492
                    'IA5String',
 
1493
                    'UniversalString',
 
1494
                    'BMPString',
 
1495
                    'ENUMERATED',
 
1496
                    'BOOLEAN']).
 
1497
 
 
1498
construct_bif(T) ->
 
1499
    lists:member(T,['SEQUENCE' ,
 
1500
                    'SEQUENCE OF' ,
 
1501
                    'CHOICE' ,
 
1502
                    'SET' ,
 
1503
                    'SET OF']).
 
1504
 
 
1505
def_to_tag(#tag{class=Class,number=Number}) ->
 
1506
    {Class,Number};
 
1507
def_to_tag(#'ObjectClassFieldType'{type=Type}) -> 
 
1508
   case Type of
 
1509
       T when tuple(T),element(1,T)==fixedtypevaluefield ->
 
1510
           {'UNIVERSAL',get_inner(Type)};
 
1511
       _ ->
 
1512
           []
 
1513
   end;
 
1514
def_to_tag(Def) ->
 
1515
    {'UNIVERSAL',get_inner(Def)}.
 
1516
    
 
1517
 
 
1518
%% Information Object Class
 
1519
 
 
1520
type_from_object(X) ->
 
1521
    case (catch lists:last(element(2,X))) of
 
1522
        {'EXIT',_} ->
 
1523
            {notype,X};
 
1524
        Normal ->
 
1525
            Normal
 
1526
    end.
 
1527
 
 
1528
 
 
1529
get_fieldtype([],_FieldName)->
 
1530
    {no_type,no_name};
 
1531
get_fieldtype([Field|Rest],FieldName) ->
 
1532
    case element(2,Field) of
 
1533
        FieldName ->
 
1534
            case element(1,Field) of
 
1535
                fixedtypevaluefield ->
 
1536
                    {element(1,Field),FieldName,element(3,Field)};
 
1537
                _ ->
 
1538
                    {element(1,Field),FieldName}
 
1539
            end;
 
1540
        _  ->
 
1541
            get_fieldtype(Rest,FieldName)
 
1542
    end.
 
1543
 
 
1544
get_fieldcategory([],_FieldName) ->
 
1545
    no_cat;
 
1546
get_fieldcategory([Field|Rest],FieldName) ->
 
1547
    case element(2,Field) of
 
1548
        FieldName ->
 
1549
            element(1,Field);
 
1550
        _ ->
 
1551
            get_fieldcategory(Rest,FieldName)
 
1552
    end.
 
1553
 
 
1554
get_typefromobject(Type) when record(Type,type) ->
 
1555
    case Type#type.def of
 
1556
        {{objectclass,_,_},TypeFrObj} when list(TypeFrObj) ->
 
1557
            {_,FieldName} = lists:last(TypeFrObj),
 
1558
            FieldName;
 
1559
        _ ->
 
1560
            {no_field}
 
1561
    end.
 
1562
 
 
1563
get_classfieldcategory(Type,FieldName) ->
 
1564
    case (catch Type#type.def) of
 
1565
        {{obejctclass,Fields,_},_} ->
 
1566
            get_fieldcategory(Fields,FieldName);
 
1567
        {'EXIT',_} ->
 
1568
            no_cat;
 
1569
        _ ->
 
1570
            no_cat
 
1571
    end.
 
1572
%% Information Object Class
 
1573
 
 
1574
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
1575
%% Convert a list of name parts to something that can be output by emit
 
1576
%% 
 
1577
%% used to output function names in generated code.
 
1578
 
 
1579
list2name(L) ->
 
1580
    NewL = list2name1(L),
 
1581
    lists:concat(lists:reverse(NewL)).
 
1582
 
 
1583
list2name1([{ptype,H1},H2|T]) ->
 
1584
    [H1,"_",list2name([H2|T])];
 
1585
list2name1([H1,H2|T]) ->
 
1586
    [H1,"_",list2name([H2|T])];
 
1587
list2name1([{ptype,H}|_T]) ->
 
1588
    [H];
 
1589
list2name1([H|_T]) ->
 
1590
    [H];
 
1591
list2name1([]) ->
 
1592
    [].
 
1593
 
 
1594
 
 
1595
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
1596
%% Convert a list of name parts to something that can be output by emit
 
1597
%% stops at {ptype,Pname} i.e Pname whill be the first part of the name
 
1598
%% used to output record names in generated code.
 
1599
 
 
1600
list2rname(L) ->
 
1601
    NewL = list2rname1(L),
 
1602
    lists:concat(lists:reverse(NewL)).
 
1603
 
 
1604
list2rname1([{ptype,H1},_H2|_T]) ->
 
1605
    [H1];
 
1606
list2rname1([H1,H2|T]) ->
 
1607
    [H1,"_",list2name([H2|T])];
 
1608
list2rname1([{ptype,H}|_T]) ->
 
1609
    [H];
 
1610
list2rname1([H|_T]) ->
 
1611
    [H];
 
1612
list2rname1([]) ->
 
1613
    [].
 
1614
 
 
1615
 
 
1616
 
 
1617
constructed_suffix(_,#'SEQUENCE'{pname=Ptypename}) when Ptypename =/= false ->
 
1618
    {ptype, Ptypename};
 
1619
constructed_suffix(_,#'SET'{pname=Ptypename}) when Ptypename =/= false ->
 
1620
    {ptype,Ptypename};
 
1621
constructed_suffix('SEQUENCE OF',_) -> 
 
1622
    'SEQOF';
 
1623
constructed_suffix('SET OF',_) -> 
 
1624
    'SETOF'.
 
1625
 
 
1626
erule(ber) ->
 
1627
    ber;
 
1628
erule(ber_bin) ->
 
1629
    ber;
 
1630
erule(ber_bin_v2) ->
 
1631
    ber_bin_v2;
 
1632
erule(per) ->
 
1633
    per;
 
1634
erule(per_bin) ->
 
1635
    per.
 
1636
 
 
1637
wrap_ber(ber) ->
 
1638
    ber_bin;
 
1639
wrap_ber(Erule) ->
 
1640
    Erule.
 
1641
 
 
1642
rt2ct_suffix() ->
 
1643
    Options = get(encoding_options),
 
1644
    case {lists:member(optimize,Options),lists:member(per_bin,Options)} of
 
1645
        {true,true} -> "_rt2ct";
 
1646
        _ -> ""
 
1647
    end.
 
1648
rt2ct_suffix(per_bin) ->
 
1649
    Options = get(encoding_options),
 
1650
    case lists:member(optimize,Options) of
 
1651
        true -> "_rt2ct";
 
1652
        _ -> ""
 
1653
    end;
 
1654
rt2ct_suffix(_) -> "".
 
1655
 
 
1656
get_constraint(C,Key) ->
 
1657
    case lists:keysearch(Key,1,C) of
 
1658
        false ->
 
1659
             no;
 
1660
        {value,{_,V}} -> 
 
1661
            V;
 
1662
        {value,Cnstr} ->
 
1663
            Cnstr
 
1664
    end.