diff options
Diffstat (limited to 'lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl')
| -rw-r--r-- | lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl | 1664 |
1 files changed, 0 insertions, 1664 deletions
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl deleted file mode 100644 index e4a0b1fd9a..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_gen.erl +++ /dev/null @@ -1,1664 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: asn1ct_gen.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_gen). - --include("asn1_records.hrl"). -%%-compile(export_all). --export([pgen_exports/3, - pgen_hrl/4, - gen_head/3, - demit/1, - emit/1, - fopen/2, - get_inner/1,type/1,def_to_tag/1,prim_bif/1, - type_from_object/1, - get_typefromobject/1,get_fieldcategory/2, - get_classfieldcategory/2, - list2name/1, - list2rname/1, - constructed_suffix/2, - unify_if_string/1, - gen_check_call/7, - get_constraint/2, - insert_once/2, - rt2ct_suffix/1,rt2ct_suffix/0]). --export([pgen/4,pgen_module/5,mk_var/1, un_hyphen_var/1]). --export([gen_encode_constructed/4,gen_decode_constructed/4]). - -%% pgen(Erules, Module, TypeOrVal) -%% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module -%% .hrl file is only generated if necessary -%% Erules = per | ber | ber_bin | per_bin -%% Module = atom() -%% TypeOrVal = {TypeList,ValueList} -%% TypeList = ValueList = [atom()] - -pgen(OutFile,Erules,Module,TypeOrVal) -> - pgen_module(OutFile,Erules,Module,TypeOrVal,true). - - -pgen_module(OutFile,Erules,Module,TypeOrVal,Indent) -> - put(outfile,OutFile), - HrlGenerated = asn1ct_gen:pgen_hrl(Erules,Module,TypeOrVal,Indent), - asn1ct_name:start(), - ErlFile = lists:concat([OutFile,".erl"]), - Fid = asn1ct_gen:fopen(ErlFile,write), - put(gen_file_out,Fid), - asn1ct_gen:gen_head(Erules,Module,HrlGenerated), - pgen_exports(Erules,Module,TypeOrVal), - pgen_dispatcher(Erules,Module,TypeOrVal), - pgen_info(Erules,Module), - pgen_typeorval(wrap_ber(Erules),Module,TypeOrVal), - pgen_partial_incomplete_decode(Erules), -% gen_vars(asn1_db:mod_to_vars(Module)), -% gen_tag_table(AllTypes), - file:close(Fid), - io:format("--~p--~n",[{generated,ErlFile}]). - - -pgen_typeorval(Erules,Module,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) -> - pgen_types(Erules,Module,Types), - pgen_values(Erules,Module,Values), - pgen_objects(Erules,Module,Objects), - pgen_objectsets(Erules,Module,ObjectSets), - case catch lists:member(der,get(encoding_options)) of - true -> - pgen_check_defaultval(Erules,Module); - _ -> ok - end, - pgen_partial_decode(Erules,Module). - -pgen_values(_,_,[]) -> - true; -pgen_values(Erules,Module,[H|T]) -> - Valuedef = asn1_db:dbget(Module,H), - gen_value(Valuedef), - pgen_values(Erules,Module,T). - -pgen_types(_,Module,[]) -> - gen_value_match(Module), - true; -pgen_types(Erules,Module,[H|T]) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Typedef = asn1_db:dbget(Module,H), - Rtmod:gen_encode(Erules,Typedef), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,Typedef), - pgen_types(Erules,Module,T). - -pgen_objects(_,_,[]) -> - true; -pgen_objects(Erules,Module,[H|T]) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Typedef = asn1_db:dbget(Module,H), - Rtmod:gen_obj_code(Erules,Module,Typedef), - pgen_objects(Erules,Module,T). - -pgen_objectsets(_,_,[]) -> - true; -pgen_objectsets(Erules,Module,[H|T]) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - TypeDef = asn1_db:dbget(Module,H), - Rtmod:gen_objectset_code(Erules,TypeDef), - pgen_objectsets(Erules,Module,T). - -pgen_check_defaultval(Erules,Module) -> - CheckObjects = ets:tab2list(check_functions), - case get(asndebug) of - true -> - FileName = lists:concat([Module,'.table']), - {ok,IoDevice} = file:open(FileName,[write]), - Fun = - fun(X)-> - io:format(IoDevice,"~n~n************~n~n~p~n~n*****" - "********~n~n",[X]) - end, - lists:foreach(Fun,CheckObjects), - file:close(IoDevice); - _ -> ok - end, - gen_check_defaultval(Erules,Module,CheckObjects). - -pgen_partial_decode(Erules,Module) -> - pgen_partial_inc_dec(Erules,Module), - pgen_partial_dec(Erules,Module). - -pgen_partial_inc_dec(Erules,Module) -> -% io:format("Start partial incomplete decode gen?~n"), - case asn1ct:get_gen_state_field(inc_type_pattern) of - undefined -> -% io:format("Partial incomplete decode gen not started:�~w~n",[asn1ct:get_gen_state_field(active)]), - ok; -% [] -> -% ok; - ConfList -> - PatternLists=lists:map(fun({_,P}) -> P end,ConfList), - pgen_partial_inc_dec1(Erules,Module,PatternLists), - gen_partial_inc_dec_refed_funcs(Erules) - end. - -%% pgen_partial_inc_dec1 generates a function of the toptype in each -%% of the partial incomplete decoded types. -pgen_partial_inc_dec1(Erules,Module,[P|Ps]) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - TopTypeName = asn1ct:partial_inc_dec_toptype(P), - TypeDef=asn1_db:dbget(Module,TopTypeName), - asn1ct_name:clear(), - asn1ct:update_gen_state(namelist,P), - asn1ct:update_gen_state(active,true), - asn1ct:update_gen_state(prefix,"dec-inc-"), - Rtmod:gen_decode(Erules,TypeDef), -%% asn1ct:update_gen_state(namelist,tl(P)), %% - gen_dec_part_inner_constr(Erules,TypeDef,[TopTypeName]), - pgen_partial_inc_dec1(Erules,Module,Ps); -pgen_partial_inc_dec1(_,_,[]) -> - ok. - -gen_partial_inc_dec_refed_funcs(Erule) when Erule == ber_bin_v2 -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erule), - rt2ct_suffix(Erule)])), - case asn1ct:next_refed_func() of - [] -> - ok; - {#'Externaltypereference'{module=M,type=Name},Pattern} -> - TypeDef = asn1_db:dbget(M,Name), - asn1ct:update_gen_state(namelist,Pattern), - Rtmod:gen_inc_decode(Erule,TypeDef), - gen_dec_part_inner_constr(Erule,TypeDef,[Name]), - gen_partial_inc_dec_refed_funcs(Erule); - _ -> - gen_partial_inc_dec_refed_funcs(Erule) - end; -gen_partial_inc_dec_refed_funcs(_) -> - ok. - -pgen_partial_dec(_Erules,_Module) -> - ok. %%%% implement later - -%% generate code for all inner types that are called from the top type -%% of the partial incomplete decode -gen_dec_part_inner_constr(Erules,TypeDef,TypeName) -> - Def = TypeDef#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - case InnerType of - 'SET' -> - #'SET'{components=Components} = Def#type.def, - gen_dec_part_inner_types(Erules,Components,TypeName); - %% Continue generate the inner of each component - 'SEQUENCE' -> - #'SEQUENCE'{components=Components} = Def#type.def, - gen_dec_part_inner_types(Erules,Components,TypeName); - 'CHOICE' -> - {_,Components} = Def#type.def, - gen_dec_part_inner_types(Erules,Components,TypeName); - 'SEQUENCE OF' -> - %% this and next case must be the last component in the - %% partial decode chain here. Not likely that this occur. - {_,Type} = Def#type.def, - NameSuffix = constructed_suffix(InnerType,Type#type.def), - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type); -%% gen_types(Erules,[NameSuffix|Typename],Type); - 'SET OF' -> - {_,Type} = Def#type.def, - NameSuffix = constructed_suffix(InnerType,Type#type.def), - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type); - _ -> - ok - end. - -gen_dec_part_inner_types(Erules,[ComponentType|Rest],TypeName) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,TypeName,ComponentType), - gen_dec_part_inner_types(Erules,Rest,TypeName); -gen_dec_part_inner_types(Erules,{Comps1,Comps2},TypeName) - when list(Comps1),list(Comps2) -> - gen_dec_part_inner_types(Erules,Comps1 ++ Comps2,TypeName); -gen_dec_part_inner_types(_,[],_) -> - ok. - - -pgen_partial_incomplete_decode(Erule) -> - case asn1ct:get_gen_state_field(active) of - true -> - pgen_partial_incomplete_decode1(Erule), - asn1ct:reset_gen_state(); - _ -> - ok - end. -pgen_partial_incomplete_decode1(ber_bin_v2) -> - case asn1ct:read_config_data(partial_incomplete_decode) of - undefined -> - ok; - Data -> - lists:foreach(fun emit_partial_incomplete_decode/1,Data) - end, - GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs), -% io:format("GeneratedFs :~n~p~n",[GeneratedFs]), - gen_part_decode_funcs(GeneratedFs,0); -pgen_partial_incomplete_decode1(_) -> ok. - -emit_partial_incomplete_decode({FuncName,TopTypeName,Pattern}) -> - emit([{asis,FuncName},"(Bytes) ->",nl, - " decode_partial_incomplete(",{asis,TopTypeName},",Bytes,",{asis,Pattern},").",nl]); -emit_partial_incomplete_decode(D) -> - throw({error,{asn1,{"bad data in asn1config file",D}}}). - -gen_part_decode_funcs([Data={Name,_,_,Type}|GeneratedFs],N) -> - InnerType = - case Type#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> - OCFTType; - _ -> - get_inner(Type#type.def) - end, - WhatKind = type(InnerType), - TypeName=list2name(Name), - if - N > 0 -> emit([";",nl]); - true -> ok - end, - emit(["decode_inc_disp('",TypeName,"',Data) ->",nl]), - gen_part_decode_funcs(WhatKind,TypeName,Data), - gen_part_decode_funcs(GeneratedFs,N+1); -gen_part_decode_funcs([_H|T],N) -> - gen_part_decode_funcs(T,N); -gen_part_decode_funcs([],N) -> - if - N > 0 -> - .emit([".",nl]); - true -> - ok - end. - -gen_part_decode_funcs(#'Externaltypereference'{module=M,type=T}, - _TypeName,Data) -> - #typedef{typespec=TS} = asn1_db:dbget(M,T), - InnerType = - case TS#type.def of - #'ObjectClassFieldType'{type=OCFTType} -> - OCFTType; - _ -> - get_inner(TS#type.def) - end, - WhatKind = type(InnerType), - gen_part_decode_funcs(WhatKind,[T],Data); -gen_part_decode_funcs({constructed,bif},TypeName, - {_Name,parts,Tag,_Type}) -> - emit([" case Data of",nl, - " L when list(L) ->",nl, - " 'dec_",TypeName,"'(lists:map(fun(X)->element(1,?RT_BER:decode(X)) end,L),",{asis,Tag},");",nl, - " _ ->",nl, - " [Res] = 'dec_",TypeName,"'([Data],",{asis,Tag},"),",nl, - " Res",nl, - " end"]); -gen_part_decode_funcs(WhatKind,_TypeName,{_Name,parts,_Tag,_Type}) -> - throw({error,{asn1,{"only SEQUENCE OF/SET OF may have the partial incomplete directive 'parts'.",WhatKind}}}); -gen_part_decode_funcs({constructed,bif},TypeName, - {_Name,undecoded,Tag,_Type}) -> - emit([" 'dec_",TypeName,"'(Data,",{asis,Tag},")"]); -gen_part_decode_funcs({primitive,bif},_TypeName, - {_Name,undecoded,Tag,Type}) -> - % Argument no 6 is 0, i.e. bit 6 for primitive encoding. - asn1ct_gen_ber_bin_v2:gen_dec_prim(ber_bin_v2,Type,"Data",Tag,[],0,", mandatory, "); -gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) -> - throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}). - -gen_types(Erules,Tname,{RootList,ExtList}) when list(RootList) -> - gen_types(Erules,Tname,RootList), - gen_types(Erules,Tname,ExtList); -gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) -> - gen_types(Erules,Tname,Rest); -gen_types(Erules,Tname,[ComponentType|Rest]) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Rtmod:gen_encode(Erules,Tname,ComponentType), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,Tname,ComponentType), - gen_types(Erules,Tname,Rest); -gen_types(_,_,[]) -> - true; -gen_types(Erules,Tname,Type) when record(Type,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), - asn1ct_name:clear(), - Rtmod:gen_encode(Erules,Tname,Type), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,Tname,Type). - -gen_value_match(Module) -> - case get(value_match) of - {true,Module} -> - emit(["value_match([{Index,Cname}|Rest],Value) ->",nl, - " Value2 =",nl, - " case element(Index,Value) of",nl, - " {Cname,Val2} -> Val2;",nl, - " X -> X",nl, - " end,",nl, - " value_match(Rest,Value2);",nl, - "value_match([],Value) ->",nl, - " Value.",nl]); - _ -> ok - end, - put(value_match,undefined). - -gen_check_defaultval(Erules,Module,[{Name,Type}|Rest]) -> - gen_check_func(Name,Type), - gen_check_defaultval(Erules,Module,Rest); -gen_check_defaultval(_,_,[]) -> - ok. - -gen_check_func(Name,FType = #type{def=Def}) -> - emit({Name,"(V,asn1_DEFAULT) ->",nl," true;",nl}), - emit({Name,"(V,V) ->",nl," true;",nl}), - emit({Name,"(V,{_,V}) ->",nl," true;",nl}), - case Def of - {'SEQUENCE OF',Type} -> - gen_check_sof(Name,'SEQOF',Type); - {'SET OF',Type} -> - gen_check_sof(Name,'SETOF',Type); - #'SEQUENCE'{components=Components} -> - gen_check_sequence(Name,Components); - #'SET'{components=Components} -> - gen_check_sequence(Name,Components); - {'CHOICE',Components} -> - gen_check_choice(Name,Components); - #'Externaltypereference'{type=T} -> - emit({Name,"(DefaultValue,Value) ->",nl}), - emit({" ",list2name([T,check]),"(DefaultValue,Value).",nl}); - MaybePrim -> - InnerType = get_inner(MaybePrim), - case type(InnerType) of - {primitive,bif} -> - emit({Name,"(DefaultValue,Value) ->",nl," "}), - gen_prim_check_call(InnerType,"DefaultValue","Value", - FType), - emit({".",nl,nl}); - _ -> - throw({asn1_error,{unknown,type,MaybePrim}}) - end - end. - -gen_check_sof(Name,SOF,Type) -> - NewName = list2name([sorted,Name]), - emit({Name,"(V1,V2) ->",nl}), - emit({" ",NewName,"(lists:sort(V1),lists:sort(V2)).",nl,nl}), - emit({NewName,"([],[]) ->",nl," true;",nl}), - emit({NewName,"([DV|DVs],[V|Vs]) ->",nl," "}), - InnerType = get_inner(Type#type.def), - case type(InnerType) of - {primitive,bif} -> - gen_prim_check_call(InnerType,"DV","V",Type), - emit({",",nl}); - {constructed,bif} -> - emit({list2name([SOF,Name]),"(DV, V),",nl}); - #'Externaltypereference'{type=T} -> - emit({list2name([T,check]),"(DV,V),",nl}) - end, - emit({" ",NewName,"(DVs,Vs).",nl,nl}). - -gen_check_sequence(Name,Components) -> - emit({Name,"(DefaultValue,Value) ->",nl}), - gen_check_sequence(Name,Components,1). -gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> - InnerType = get_inner(Type#type.def), -% NthDefV = lists:concat(["lists:nth(",Num,",DefaultValue)"]), - NthDefV = ["element(",Num+1,",DefaultValue)"], -% NthV = lists:concat(["lists:nth(",Num,",Value)"]), - NthV = ["element(",Num+1,",Value)"], - gen_check_func_call(Name,Type,InnerType,NthDefV,NthV,N), - case Cs of - [] -> - emit({".",nl,nl}); - _ -> - emit({",",nl}), - gen_check_sequence(Name,Cs,Num+1) - end; -gen_check_sequence(_,[],_) -> - ok. - -gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> - emit({Name,"({Id,DefaultValue},{Id,Value}) ->",nl}), - emit({" case Id of",nl}), - gen_check_choice_components(Name,CList,1). - -gen_check_choice_components(_,[],_)-> - ok; -gen_check_choice_components(Name,[#'ComponentType'{name=N,typespec=Type}| - Cs],Num) -> - Ind6 = " ", - InnerType = get_inner(Type#type.def), -% DefVal = ["element(2,lists:nth(",Num,",DefaultValue))"], - emit({Ind6,N," ->",nl,Ind6}), - gen_check_func_call(Name,Type,InnerType,{var,"defaultValue"}, - {var,"value"},N), - case Cs of - [] -> - emit({nl," end.",nl,nl}); - _ -> - emit({";",nl}), - gen_check_choice_components(Name,Cs,Num+1) - end. - -gen_check_func_call(Name,Type,InnerType,DefVal,Val,N) -> - case type(InnerType) of - {primitive,bif} -> - emit(" "), - gen_prim_check_call(InnerType,DefVal,Val,Type); - #'Externaltypereference'{type=T} -> - emit({" ",list2name([T,check]),"(",DefVal,",",Val,")"}); - _ -> - emit({" ",list2name([N,Name]),"(",DefVal,",",Val,")"}) - end. - - -%% VARIOUS GENERATOR STUFF -%% ************************************************* -%%************************************************** - -mk_var(X) when atom(X) -> - list_to_atom(mk_var(atom_to_list(X))); - -mk_var([H|T]) -> - [H-32|T]. - -%% Since hyphens are allowed in ASN.1 names, it may occur in a -%% variable to. Turn a hyphen into a under-score sign. -un_hyphen_var(X) when atom(X) -> - list_to_atom(un_hyphen_var(atom_to_list(X))); -un_hyphen_var([45|T]) -> - [95|un_hyphen_var(T)]; -un_hyphen_var([H|T]) -> - [H|un_hyphen_var(T)]; -un_hyphen_var([]) -> - []. - -%% Generate value functions *************** -%% **************************************** -%% Generates a function 'V'/0 for each Value V defined in the ASN.1 module -%% the function returns the value in an Erlang representation which can be -%% used as input to the runtime encode functions - -gen_value(Value) when record(Value,valuedef) -> -%% io:format(" ~w ",[Value#valuedef.name]), - emit({"'",Value#valuedef.name,"'() ->",nl}), - V = Value#valuedef.value, - emit([{asis,V},".",nl,nl]). - -gen_encode_constructed(Erules,Typename,InnerType,D) when record(D,type) -> - - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), - case InnerType of - 'SET' -> - Rtmod:gen_encode_set(Erules,Typename,D), - #'SET'{components=Components} = D#type.def, - gen_types(Erules,Typename,Components); - 'SEQUENCE' -> - Rtmod:gen_encode_sequence(Erules,Typename,D), - #'SEQUENCE'{components=Components} = D#type.def, - gen_types(Erules,Typename,Components); - 'CHOICE' -> - Rtmod:gen_encode_choice(Erules,Typename,D), - {_,Components} = D#type.def, - gen_types(Erules,Typename,Components); - 'SEQUENCE OF' -> - Rtmod:gen_encode_sof(Erules,Typename,InnerType,D), - {_,Type} = D#type.def, - NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - gen_types(Erules,[NameSuffix|Typename],Type); - 'SET OF' -> - Rtmod:gen_encode_sof(Erules,Typename,InnerType,D), - {_,Type} = D#type.def, - NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - gen_types(Erules,[NameSuffix|Typename],Type); - _ -> - exit({nyi,InnerType}) - end; -gen_encode_constructed(Erules,Typename,InnerType,D) - when record(D,typedef) -> - gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec). - -gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), - asn1ct:step_in_constructed(), %% updates namelist for incomplete - %% partial decode - case InnerType of - 'SET' -> - Rtmod:gen_decode_set(Erules,Typename,D); - 'SEQUENCE' -> - Rtmod:gen_decode_sequence(Erules,Typename,D); - 'CHOICE' -> - Rtmod:gen_decode_choice(Erules,Typename,D); - 'SEQUENCE OF' -> - Rtmod:gen_decode_sof(Erules,Typename,InnerType,D); - 'SET OF' -> - Rtmod:gen_decode_sof(Erules,Typename,InnerType,D); - _ -> - exit({nyi,InnerType}) - end; - - -gen_decode_constructed(Erules,Typename,InnerType,D) when record(D,typedef) -> - gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec). - - -pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit({"-export([encoding_rule/0]).",nl}), - case Types of - [] -> ok; - _ -> - emit({"-export([",nl}), - case Erules of - ber -> - gen_exports1(Types,"enc_",2); - ber_bin -> - gen_exports1(Types,"enc_",2); - ber_bin_v2 -> - gen_exports1(Types,"enc_",2); - _ -> - gen_exports1(Types,"enc_",1) - end, - emit({"-export([",nl}), - gen_exports1(Types,"dec_",2), - case Erules of - ber -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",3); - ber_bin -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",3); - ber_bin_v2 -> - emit({"-export([",nl}), - gen_exports1(Types,"dec_",2); - _ -> ok - end - end, - case Values of - [] -> ok; - _ -> - emit({"-export([",nl}), - gen_exports1(Values,"",0) - end, - case Objects of - [] -> ok; - _ -> - case erule(Erules) of - per -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",3), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",4); - ber_bin_v2 -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",3), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",3); - _ -> - emit({"-export([",nl}), - gen_exports1(Objects,"enc_",4), - emit({"-export([",nl}), - gen_exports1(Objects,"dec_",4) - end - end, - case ObjectSets of - [] -> ok; - _ -> - emit({"-export([",nl}), - gen_exports1(ObjectSets,"getenc_",2), - emit({"-export([",nl}), - gen_exports1(ObjectSets,"getdec_",2) - end, - emit({"-export([info/0]).",nl}), - gen_partial_inc_decode_exports(), - emit({nl,nl}). - -gen_exports1([F1,F2|T],Prefix,Arity) -> - emit({"'",Prefix,F1,"'/",Arity,com,nl}), - gen_exports1([F2|T],Prefix,Arity); -gen_exports1([Flast|_T],Prefix,Arity) -> - emit({"'",Prefix,Flast,"'/",Arity,nl,"]).",nl,nl}). - -gen_partial_inc_decode_exports() -> - case {asn1ct:read_config_data(partial_incomplete_decode), - asn1ct:get_gen_state_field(inc_type_pattern)} of - {undefined,_} -> - ok; - {_,undefined} -> - ok; - {Data,_} -> - gen_partial_inc_decode_exports(Data), - emit("-export([decode_part/2]).") - end. -gen_partial_inc_decode_exports([]) -> - ok; -gen_partial_inc_decode_exports([{Name,_,_}|Rest]) -> - emit(["-export([",Name,"/1"]), - gen_partial_inc_decode_exports1(Rest); -gen_partial_inc_decode_exports([_|Rest]) -> - gen_partial_inc_decode_exports(Rest). - -gen_partial_inc_decode_exports1([]) -> - emit(["]).",nl]); -gen_partial_inc_decode_exports1([{Name,_,_}|Rest]) -> - emit([", ",Name,"/1"]), - gen_partial_inc_decode_exports1(Rest); -gen_partial_inc_decode_exports1([_|Rest]) -> - gen_partial_inc_decode_exports1(Rest). - -pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) -> - emit(["encoding_rule() ->",nl]), - emit([{asis,Erules},".",nl,nl]); -pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> - emit(["-export([encode/2,decode/2,encode_disp/2,decode_disp/2]).",nl,nl]), - emit(["encoding_rule() ->",nl]), - emit([" ",{asis,Erules},".",nl,nl]), - Call = case Erules of - per -> "?RT_PER:complete(encode_disp(Type,Data))"; - per_bin -> "?RT_PER:complete(encode_disp(Type,Data))"; - ber -> "encode_disp(Type,Data)"; - ber_bin -> "encode_disp(Type,Data)"; - ber_bin_v2 -> "encode_disp(Type,Data)" - end, - EncWrap = case Erules of - ber -> "wrap_encode(Bytes)"; - _ -> "Bytes" - end, - emit(["encode(Type,Data) ->",nl, - "case catch ",Call," of",nl, - " {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl, - " {Bytes,_Len} ->",nl, - " {ok,",EncWrap,"};",nl, - " Bytes ->",nl, - " {ok,",EncWrap,"}",nl, - "end.",nl,nl]), - - case Erules of - ber_bin_v2 -> - emit(["decode(Type,Data0) ->",nl]), - emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",driver_parameter(),"),",nl]); - _ -> - emit(["decode(Type,Data) ->",nl]) - end, - DecWrap = case Erules of - ber -> "wrap_decode(Data)"; - _ -> "Data" - end, - - emit(["case catch decode_disp(Type,",DecWrap,") of",nl, - " {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl]), - case Erules of - ber_bin_v2 -> - emit([" Result ->",nl, - " {ok,Result}",nl]); - _ -> - emit([" {X,_Rest} ->",nl, - " {ok,X};",nl, - " {X,_Rest,_Len} ->",nl, - " {ok,X}",nl]) - end, - emit(["end.",nl,nl]), - - gen_decode_partial_incomplete(Erules), - - case Types of - [] -> ok; - _ -> - case Erules of - ber -> - gen_dispatcher(Types,"encode_disp","enc_",",[]"), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory"); - ber_bin -> - gen_dispatcher(Types,"encode_disp","enc_",",[]"), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory"); - ber_bin_v2 -> - gen_dispatcher(Types,"encode_disp","enc_",""), - gen_dispatcher(Types,"decode_disp","dec_",""), - gen_partial_inc_dispatcher(); - _PerOrPer_bin -> - gen_dispatcher(Types,"encode_disp","enc_",""), - gen_dispatcher(Types,"decode_disp","dec_",",mandatory") - end, - emit([nl]) - end, - case Erules of - ber -> - gen_wrapper(); - _ -> ok - end, - emit({nl,nl}). - - -gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; - Erule==ber_bin_v2 -> - case {asn1ct:read_config_data(partial_incomplete_decode), - asn1ct:get_gen_state_field(inc_type_pattern)} of - {undefined,_} -> - ok; - {_,undefined} -> - ok; - _ -> - case Erule of - ber_bin_v2 -> - EmitCaseClauses = - fun() -> - emit([" {'EXIT',{error,Reason}} ->",nl, - " {error,Reason};",nl, - " {'EXIT',Reason} ->",nl, - " {error,{asn1,Reason}};",nl, - " Result ->",nl, - " {ok,Result}",nl, - " end.",nl,nl]) - end, - emit(["decode_partial_incomplete(Type,Data0,", - "Pattern) ->",nl]), - emit([" {Data,_RestBin} =",nl, - " ?RT_BER:decode_primitive_", - "incomplete(Pattern,Data0),",nl, - " case catch decode_partial_inc_disp(Type,", - "Data) of",nl]), - EmitCaseClauses(), - emit(["decode_part(Type,Data0) ->",nl, - " {Data,_RestBin} = ?RT_BER:decode(Data0),",nl, - " case catch decode_inc_disp(Type,Data) of",nl]), - EmitCaseClauses(); - _ -> ok % add later - end - end; -gen_decode_partial_incomplete(_Erule) -> - ok. - -gen_partial_inc_dispatcher() -> - case {asn1ct:read_config_data(partial_incomplete_decode), - asn1ct:get_gen_state_field(inc_type_pattern)} of - {undefined,_} -> - ok; - {_,undefined} -> - ok; - {Data,_} -> - gen_partial_inc_dispatcher(Data) - end. -gen_partial_inc_dispatcher([{_FuncName,TopType,_Pattern}|Rest]) -> - emit(["decode_partial_inc_disp(",{asis,TopType},",Data) ->",nl, - " ",{asis,list_to_atom(lists:concat([dec,"-inc-",TopType]))}, - "(Data);",nl]), - gen_partial_inc_dispatcher(Rest); -gen_partial_inc_dispatcher([]) -> - emit(["decode_partial_inc_disp(Type,_Data) ->",nl, - " exit({error,{asn1,{undefined_type,Type}}}).",nl]). - -driver_parameter() -> - Options = get(encoding_options), - case lists:member(driver,Options) of - true -> - ",driver"; - _ -> "" - end. - -gen_wrapper() -> - emit(["wrap_encode(Bytes) when list(Bytes) ->",nl, - " binary_to_list(list_to_binary(Bytes));",nl, - "wrap_encode(Bytes) when binary(Bytes) ->",nl, - " binary_to_list(Bytes);",nl, - "wrap_encode(Bytes) -> Bytes.",nl,nl]), - emit(["wrap_decode(Bytes) when list(Bytes) ->",nl, - " list_to_binary(Bytes);",nl, - "wrap_decode(Bytes) -> Bytes.",nl]). - -gen_dispatcher([F1,F2|T],FuncName,Prefix,ExtraArg) -> - emit([FuncName,"('",F1,"',Data) -> '",Prefix,F1,"'(Data",ExtraArg,")",";",nl]), - gen_dispatcher([F2|T],FuncName,Prefix,ExtraArg); -gen_dispatcher([Flast|_T],FuncName,Prefix,ExtraArg) -> - emit([FuncName,"('",Flast,"',Data) -> '",Prefix,Flast,"'(Data",ExtraArg,")",";",nl]), - emit([FuncName,"(","Type",",_Data) -> exit({error,{asn1,{undefined_type,Type}}}).",nl,nl,nl]). - -pgen_info(_Erules,Module) -> - Options = get(encoding_options), - emit({"info() ->",nl, - " [{vsn,'",asn1ct:vsn(),"'},", - " {module,'",Module,"'},", - " {options,",io_lib:format("~p",[Options]),"}].",nl}). - -open_hrl(OutFile,Module) -> - File = lists:concat([OutFile,".hrl"]), - Fid = fopen(File,write), - put(gen_file_out,Fid), - gen_hrlhead(Module). - -%% EMIT functions ************************ -%% *************************************** - - % debug generation -demit(Term) -> - case get(asndebug) of - true -> emit(Term); - _ ->true - end. - - % always generation - -emit({external,_M,T}) -> - emit(T); - -emit({prev,Variable}) when atom(Variable) -> - emit({var,asn1ct_name:prev(Variable)}); - -emit({next,Variable}) when atom(Variable) -> - emit({var,asn1ct_name:next(Variable)}); - -emit({curr,Variable}) when atom(Variable) -> - emit({var,asn1ct_name:curr(Variable)}); - -emit({var,Variable}) when atom(Variable) -> - [Head|V] = atom_to_list(Variable), - emit([Head-32|V]); - -emit({var,Variable}) -> - [Head|V] = Variable, - emit([Head-32|V]); - -emit({asis,What}) -> - format(get(gen_file_out),"~w",[What]); - -emit(nl) -> - nl(get(gen_file_out)); - -emit(com) -> - emit(","); - -emit(tab) -> - put_chars(get(gen_file_out)," "); - -emit(What) when integer(What) -> - put_chars(get(gen_file_out),integer_to_list(What)); - -emit(What) when list(What), integer(hd(What)) -> - put_chars(get(gen_file_out),What); - -emit(What) when atom(What) -> - put_chars(get(gen_file_out),atom_to_list(What)); - -emit(What) when tuple(What) -> - emit_parts(tuple_to_list(What)); - -emit(What) when list(What) -> - emit_parts(What); - -emit(X) -> - exit({'cant emit ',X}). - -emit_parts([]) -> true; -emit_parts([H|T]) -> - emit(H), - emit_parts(T). - -format(undefined,X,Y) -> - io:format(X,Y); -format(X,Y,Z) -> - io:format(X,Y,Z). - -nl(undefined) -> io:nl(); -nl(X) -> io:nl(X). - -put_chars(undefined,X) -> - io:put_chars(X); -put_chars(Y,X) -> - io:put_chars(Y,X). - -fopen(F, Mode) -> - case file:open(F, [Mode]) of - {ok, Fd} -> - Fd; - {error, Reason} -> - io:format("** Can't open file ~p ~n", [F]), - exit({error,Reason}) - end. - -pgen_hrl(Erules,Module,TypeOrVal,_Indent) -> - put(currmod,Module), - {Types,Values,Ptypes,_,_,_} = TypeOrVal, - Ret = - case pgen_hrltypes(Erules,Module,Ptypes++Types,0) of - 0 -> - case Values of - [] -> - 0; - _ -> - open_hrl(get(outfile),get(currmod)), - pgen_macros(Erules,Module,Values), - 1 - end; - X -> - pgen_macros(Erules,Module,Values), - X - end, - case Ret of - 0 -> - 0; - Y -> - Fid = get(gen_file_out), - file:close(Fid), - io:format("--~p--~n", - [{generated,lists:concat([get(outfile),".hrl"])}]), - Y - end. - -pgen_macros(_,_,[]) -> - true; -pgen_macros(Erules,Module,[H|T]) -> - Valuedef = asn1_db:dbget(Module,H), - gen_macro(Valuedef), - pgen_macros(Erules,Module,T). - -pgen_hrltypes(_,_,[],NumRecords) -> - NumRecords; -pgen_hrltypes(Erules,Module,[H|T],NumRecords) -> -% io:format("records = ~p~n",NumRecords), - Typedef = asn1_db:dbget(Module,H), - AddNumRecords = gen_record(Typedef,NumRecords), - pgen_hrltypes(Erules,Module,T,NumRecords+AddNumRecords). - - -%% Generates a macro for value Value defined in the ASN.1 module -gen_macro(Value) when record(Value,valuedef) -> - emit({"-define('",Value#valuedef.name,"', ", - {asis,Value#valuedef.value},").",nl}). - -%% Generate record functions ************** -%% Generates an Erlang record for each named and unnamed SEQUENCE and SET in the ASN.1 -%% module. If no SEQUENCE or SET is found there is no .hrl file generated - - -gen_record(Tdef,NumRecords) when record(Tdef,typedef) -> - Name = [Tdef#typedef.name], - Type = Tdef#typedef.typespec, - gen_record(type,Name,Type,NumRecords); - -gen_record(Tdef,NumRecords) when record(Tdef,ptypedef) -> - Name = [Tdef#ptypedef.name], - Type = Tdef#ptypedef.typespec, - gen_record(ptype,Name,Type,NumRecords). - -gen_record(TorPtype,Name,[#'ComponentType'{name=Cname,typespec=Type}|T],Num) -> - Num2 = gen_record(TorPtype,[Cname|Name],Type,Num), - gen_record(TorPtype,Name,T,Num2); -gen_record(TorPtype,Name,{Clist1,Clist2},Num) when list(Clist1), list(Clist2) -> - gen_record(TorPtype,Name,Clist1++Clist2,Num); -gen_record(TorPtype,Name,[_|T],Num) -> % skip EXTENSIONMARK - gen_record(TorPtype,Name,T,Num); -gen_record(_TorPtype,_Name,[],Num) -> - Num; - -gen_record(TorPtype,Name,Type,Num) when record(Type,type) -> - Def = Type#type.def, - Rec = case Def of - Seq when record(Seq,'SEQUENCE') -> - case Seq#'SEQUENCE'.pname of - false -> - {record,Seq#'SEQUENCE'.components}; - _Pname when TorPtype == type -> - false; - _ -> - {record,Seq#'SEQUENCE'.components} - end; - Set when record(Set,'SET') -> - case Set#'SET'.pname of - false -> - {record,Set#'SET'.components}; - _Pname when TorPtype == type -> - false; - _ -> - {record,Set#'SET'.components} - end; -% {'SET',{_,_CompList}} -> -% {record,_CompList}; - {'CHOICE',_CompList} -> {inner,Def}; - {'SEQUENCE OF',_CompList} -> {['SEQOF'|Name],Def}; - {'SET OF',_CompList} -> {['SETOF'|Name],Def}; - _ -> false - end, - case Rec of - false -> Num; - {record,CompList} -> - case Num of - 0 -> open_hrl(get(outfile),get(currmod)); - _ -> true - end, - emit({"-record('",list2name(Name),"',{",nl}), - RootList = case CompList of - _ when list(CompList) -> - CompList; - {_Rl,_} -> _Rl - end, - gen_record2(Name,'SEQUENCE',RootList), - NewCompList = - case CompList of - {CompList1,[]} -> - emit({"}). % with extension mark",nl,nl}), - CompList1; - {Tr,ExtensionList2} -> - case Tr of - [] -> true; - _ -> emit({",",nl}) - end, - emit({"%% with extensions",nl}), - gen_record2(Name, 'SEQUENCE', ExtensionList2, - "", ext), - emit({"}).",nl,nl}), - Tr ++ ExtensionList2; - _ -> - emit({"}).",nl,nl}), - CompList - end, - gen_record(TorPtype,Name,NewCompList,Num+1); - {inner,{'CHOICE', CompList}} -> - gen_record(TorPtype,Name,CompList,Num); - {NewName,{_, CompList}} -> - gen_record(TorPtype,NewName,CompList,Num) - end; -gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now. - NumRecords. - -gen_head(Erules,Mod,Hrl) -> - {Rtmac,Rtmod} = case Erules of - per -> - emit({"%% Generated by the Erlang ASN.1 PER-" - "compiler version:",asn1ct:vsn(),nl}), - {"RT_PER",?RT_PER}; - ber -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version:",asn1ct:vsn(),nl}), - {"RT_BER",?RT_BER_BIN}; - per_bin -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - %% temporary code to enable rt2ct optimization - Options = get(encoding_options), - case lists:member(optimize,Options) of - true -> {"RT_PER","asn1rt_per_bin_rt2ct"}; - _ -> - {"RT_PER",?RT_PER_BIN} - end; - ber_bin -> - emit({"%% Generated by the Erlang ASN.1 BER-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_BER",?RT_BER_BIN}; - ber_bin_v2 -> - emit({"%% Generated by the Erlang ASN.1 BER_V2-" - "compiler version, utilizing bit-syntax:", - asn1ct:vsn(),nl}), - {"RT_BER","asn1rt_ber_bin_v2"} - end, - emit({"%% Purpose: encoder and decoder to the types in mod ",Mod,nl,nl}), - emit({"-module('",Mod,"').",nl}), - put(currmod,Mod), - %emit({"-compile(export_all).",nl}), - case Hrl of - 0 -> true; - _ -> - emit({"-include(\"",Mod,".hrl\").",nl}) - end, - emit(["-define('",Rtmac,"',",Rtmod,").",nl]). - - -gen_hrlhead(Mod) -> - emit({"%% Generated by the Erlang ASN.1 compiler version:",asn1ct:vsn(),nl}), - emit({"%% Purpose: Erlang record definitions for each named and unnamed",nl}), - emit({"%% SEQUENCE and SET, and macro definitions for each value",nl}), - emit({"%% definition,in module ",Mod,nl,nl}), - emit({nl,nl}). - -gen_record2(Name,SeqOrSet,Comps) -> - gen_record2(Name,SeqOrSet,Comps,"",noext). - -gen_record2(_Name,_SeqOrSet,[],_Com,_Extension) -> - true; -gen_record2(Name,SeqOrSet,[{'EXTENSIONMARK',_,_}|T],Com,Extension) -> - gen_record2(Name,SeqOrSet,T,Com,Extension); -gen_record2(_Name,_SeqOrSet,[H],Com,Extension) -> - #'ComponentType'{name=Cname} = H, - emit(Com), - emit({asis,Cname}), - gen_record_default(H, Extension); -gen_record2(Name,SeqOrSet,[H|T],Com, Extension) -> - #'ComponentType'{name=Cname} = H, - emit(Com), - emit({asis,Cname}), - gen_record_default(H, Extension), -% emit(", "), - gen_record2(Name,SeqOrSet,T,", ", Extension). - -%gen_record_default(C, ext) -> -% emit(" = asn1_NOEXTVALUE"); -gen_record_default(#'ComponentType'{prop='OPTIONAL'}, _)-> - emit(" = asn1_NOVALUE"); -gen_record_default(#'ComponentType'{prop={'DEFAULT',_}}, _)-> - emit(" = asn1_DEFAULT"); -gen_record_default(_, _) -> - true. - -gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) -> - case WhatKind of - {primitive,bif} -> - gen_prim_check_call(InnerType,DefaultValue,Element,Type); - #'Externaltypereference'{module=M,type=T} -> - %% generate function call - Name = list2name([T,check]), - emit({"'",Name,"'(",DefaultValue,", ",Element,")"}), - %% insert in ets table and do look ahead check - Typedef = asn1_db:dbget(M,T), - RefType = Typedef#typedef.typespec, - InType = asn1ct_gen:get_inner(RefType#type.def), - case insert_once(check_functions,{Name,RefType}) of - true -> - lookahead_innertype([T],InType,RefType); -% case asn1ct_gen:type(InType) of -% {constructed,bif} -> -% lookahead_innertype([T],InType,RefType); -% #'Externaltypereference'{type=TNew} -> -% lookahead_innertype([TNew],InType,RefType); -% _ -> -% ok -% end; - _ -> - ok - end; - {constructed,bif} -> - NameList = [Cname|TopType], - Name = list2name(NameList ++ [check]), - emit({"'",Name,"'(",DefaultValue,", ",Element,")"}), - ets:insert(check_functions,{Name,Type}), - %% Must look for check functions in InnerType, - %% that may be referenced or internal defined - %% constructed types not used elsewhere. - lookahead_innertype(NameList,InnerType,Type) - end. - -gen_prim_check_call(PrimType,DefaultValue,Element,Type) -> - case unify_if_string(PrimType) of - 'BOOLEAN' -> - emit({"asn1rt_check:check_bool(",DefaultValue,", ", - Element,")"}); - 'INTEGER' -> - NNL = - case Type#type.def of - {_,NamedNumberList} -> NamedNumberList; - _ -> [] - end, - emit({"asn1rt_check:check_int(",DefaultValue,", ", - Element,", ",{asis,NNL},")"}); - 'BIT STRING' -> - {_,NBL} = Type#type.def, - emit({"asn1rt_check:check_bitstring(",DefaultValue,", ", - Element,", ",{asis,NBL},")"}); - 'OCTET STRING' -> - emit({"asn1rt_check:check_octetstring(",DefaultValue,", ", - Element,")"}); - 'NULL' -> - emit({"asn1rt_check:check_null(",DefaultValue,", ", - Element,")"}); - 'OBJECT IDENTIFIER' -> - emit({"asn1rt_check:check_objectidentifier(",DefaultValue, - ", ",Element,")"}); - 'ObjectDescriptor' -> - emit({"asn1rt_check:check_objectdescriptor(",DefaultValue, - ", ",Element,")"}); - 'REAL' -> - emit({"asn1rt_check:check_real(",DefaultValue, - ", ",Element,")"}); - 'ENUMERATED' -> - {_,Enumerations} = Type#type.def, - emit({"asn1rt_check:check_enum(",DefaultValue, - ", ",Element,", ",{asis,Enumerations},")"}); - restrictedstring -> - emit({"asn1rt_check:check_restrictedstring(",DefaultValue, - ", ",Element,")"}) - end. - -%% lokahead_innertype/3 traverses Type and checks if check functions -%% have to be generated, i.e. for all constructed or referenced types. -lookahead_innertype(Name,'SEQUENCE',Type) -> - Components = (Type#type.def)#'SEQUENCE'.components, - lookahead_components(Name,Components); -lookahead_innertype(Name,'SET',Type) -> - Components = (Type#type.def)#'SET'.components, - lookahead_components(Name,Components); -lookahead_innertype(Name,'CHOICE',Type) -> - {_,Components} = Type#type.def, - lookahead_components(Name,Components); -lookahead_innertype(Name,'SEQUENCE OF',SeqOf) -> - lookahead_sof(Name,'SEQOF',SeqOf); -lookahead_innertype(Name,'SET OF',SeqOf) -> - lookahead_sof(Name,'SETOF',SeqOf); -lookahead_innertype(_Name,#'Externaltypereference'{module=M,type=T},_) -> - Typedef = asn1_db:dbget(M,T), - RefType = Typedef#typedef.typespec, - InType = asn1ct_gen:get_inner(RefType#type.def), - case type(InType) of - {constructed,bif} -> - NewName = list2name([T,check]), - case insert_once(check_functions,{NewName,RefType}) of - true -> - lookahead_innertype([T],InType,RefType); - _ -> - ok - end; - #'Externaltypereference'{} -> - NewName = list2name([T,check]), - case insert_once(check_functions,{NewName,RefType}) of - true -> - lookahead_innertype([T],InType,RefType); - _ -> - ok - end; - _ -> - ok - end; -% case insert_once(check_functions,{list2name(Name++[check]),Type}) of -% true -> -% InnerType = asn1ct_gen:get_inner(Type#type.def), -% case asn1ct_gen:type(InnerType) of -% {constructed,bif} -> -% lookahead_innertype([T],InnerType,Type); -% #'Externaltypereference'{type=TNew} -> -% lookahead_innertype([TNew],InnerType,Type); -% _ -> -% ok -% end; -% _ -> -% ok -% end; -lookahead_innertype(_,_,_) -> - ok. - -lookahead_components(_,[]) -> ok; -lookahead_components(Name,[C|Cs]) -> - #'ComponentType'{name=Cname,typespec=Type} = C, - InType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InType) of - {constructed,bif} -> - case insert_once(check_functions, - {list2name([Cname|Name] ++ [check]),Type}) of - true -> - lookahead_innertype([Cname|Name],InType,Type); - _ -> - ok - end; - #'Externaltypereference'{module=RefMod,type=RefName} -> - Typedef = asn1_db:dbget(RefMod,RefName), - RefType = Typedef#typedef.typespec, - case insert_once(check_functions,{list2name([RefName,check]), - RefType}) of - true -> - lookahead_innertype([RefName],InType,RefType); - _ -> - ok - end; - _ -> - ok - end, - lookahead_components(Name,Cs). - -lookahead_sof(Name,SOF,SOFType) -> - Type = case SOFType#type.def of - {_,_Type} -> _Type; - _Type -> _Type - end, - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - %% this is if a constructed type is defined in - %% the SEQUENCE OF type - NameList = [SOF|Name], - insert_once(check_functions, - {list2name(NameList ++ [check]),Type}), - lookahead_innertype(NameList,InnerType,Type); - #'Externaltypereference'{module=M,type=T} -> - Typedef = asn1_db:dbget(M,T), - RefType = Typedef#typedef.typespec, - InType = get_inner(RefType#type.def), - case insert_once(check_functions, - {list2name([T,check]),RefType}) of - true -> - lookahead_innertype([T],InType,RefType); - _ -> - ok - end; - _ -> - ok - end. - - -insert_once(Table,Object) -> - case ets:lookup(Table,element(1,Object)) of - [] -> - ets:insert(Table,Object); %returns true - _ -> false - end. - -unify_if_string(PrimType) -> - case PrimType of - 'NumericString' -> - restrictedstring; - 'PrintableString' -> - restrictedstring; - 'TeletexString' -> - restrictedstring; - 'VideotexString' -> - restrictedstring; - 'IA5String' -> - restrictedstring; - 'UTCTime' -> - restrictedstring; - 'GeneralizedTime' -> - restrictedstring; - 'GraphicString' -> - restrictedstring; - 'VisibleString' -> - restrictedstring; - 'GeneralString' -> - restrictedstring; - 'UniversalString' -> - restrictedstring; - 'BMPString' -> - restrictedstring; - Other -> Other - end. - - - - - -get_inner(A) when atom(A) -> A; -get_inner(Ext) when record(Ext,'Externaltypereference') -> Ext; -get_inner(Tref) when record(Tref,typereference) -> Tref; -get_inner({fixedtypevaluefield,_,Type}) -> - if - record(Type,type) -> - get_inner(Type#type.def); - true -> - get_inner(Type) - end; -get_inner({typefield,TypeName}) -> - TypeName; -get_inner(#'ObjectClassFieldType'{type=Type}) -> -% get_inner(Type); - Type; -get_inner(T) when tuple(T) -> - case element(1,T) of - Tuple when tuple(Tuple),element(1,Tuple) == objectclass -> - case catch(lists:last(element(2,T))) of - {valuefieldreference,FieldName} -> - get_fieldtype(element(2,Tuple),FieldName); - {typefieldreference,FieldName} -> - get_fieldtype(element(2,Tuple),FieldName); - {'EXIT',Reason} -> - throw({asn1,{'internal error in get_inner/1',Reason}}) - end; - _ -> element(1,T) - end. - - - - - -type(X) when record(X,'Externaltypereference') -> - X; -type(X) when record(X,typereference) -> - X; -type('ASN1_OPEN_TYPE') -> - 'ASN1_OPEN_TYPE'; -type({fixedtypevaluefield,_Name,Type}) when record(Type,type) -> - type(get_inner(Type#type.def)); -type({typefield,_}) -> - 'ASN1_OPEN_TYPE'; -type(X) -> - %% io:format("asn1_types:type(~p)~n",[X]), - case catch type2(X) of - {'EXIT',_} -> - {notype,X}; - Normal -> - Normal - end. - -type2(X) -> - case prim_bif(X) of - true -> - {primitive,bif}; - false -> - case construct_bif(X) of - true -> - {constructed,bif}; - false -> - {undefined,user} - end - end. - -prim_bif(X) -> - lists:member(X,['INTEGER' , - 'ENUMERATED', - 'OBJECT IDENTIFIER', - 'ANY', - 'NULL', - 'BIT STRING' , - 'OCTET STRING' , - 'ObjectDescriptor', - 'NumericString', - 'TeletexString', - 'VideotexString', - 'UTCTime', - 'GeneralizedTime', - 'GraphicString', - 'VisibleString', - 'GeneralString', - 'PrintableString', - 'IA5String', - 'UniversalString', - 'BMPString', - 'ENUMERATED', - 'BOOLEAN']). - -construct_bif(T) -> - lists:member(T,['SEQUENCE' , - 'SEQUENCE OF' , - 'CHOICE' , - 'SET' , - 'SET OF']). - -def_to_tag(#tag{class=Class,number=Number}) -> - {Class,Number}; -def_to_tag(#'ObjectClassFieldType'{type=Type}) -> - case Type of - T when tuple(T),element(1,T)==fixedtypevaluefield -> - {'UNIVERSAL',get_inner(Type)}; - _ -> - [] - end; -def_to_tag(Def) -> - {'UNIVERSAL',get_inner(Def)}. - - -%% Information Object Class - -type_from_object(X) -> - case (catch lists:last(element(2,X))) of - {'EXIT',_} -> - {notype,X}; - Normal -> - Normal - end. - - -get_fieldtype([],_FieldName)-> - {no_type,no_name}; -get_fieldtype([Field|Rest],FieldName) -> - case element(2,Field) of - FieldName -> - case element(1,Field) of - fixedtypevaluefield -> - {element(1,Field),FieldName,element(3,Field)}; - _ -> - {element(1,Field),FieldName} - end; - _ -> - get_fieldtype(Rest,FieldName) - end. - -get_fieldcategory([],_FieldName) -> - no_cat; -get_fieldcategory([Field|Rest],FieldName) -> - case element(2,Field) of - FieldName -> - element(1,Field); - _ -> - get_fieldcategory(Rest,FieldName) - end. - -get_typefromobject(Type) when record(Type,type) -> - case Type#type.def of - {{objectclass,_,_},TypeFrObj} when list(TypeFrObj) -> - {_,FieldName} = lists:last(TypeFrObj), - FieldName; - _ -> - {no_field} - end. - -get_classfieldcategory(Type,FieldName) -> - case (catch Type#type.def) of - {{obejctclass,Fields,_},_} -> - get_fieldcategory(Fields,FieldName); - {'EXIT',_} -> - no_cat; - _ -> - no_cat - end. -%% Information Object Class - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Convert a list of name parts to something that can be output by emit -%% -%% used to output function names in generated code. - -list2name(L) -> - NewL = list2name1(L), - lists:concat(lists:reverse(NewL)). - -list2name1([{ptype,H1},H2|T]) -> - [H1,"_",list2name([H2|T])]; -list2name1([H1,H2|T]) -> - [H1,"_",list2name([H2|T])]; -list2name1([{ptype,H}|_T]) -> - [H]; -list2name1([H|_T]) -> - [H]; -list2name1([]) -> - []. - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Convert a list of name parts to something that can be output by emit -%% stops at {ptype,Pname} i.e Pname whill be the first part of the name -%% used to output record names in generated code. - -list2rname(L) -> - NewL = list2rname1(L), - lists:concat(lists:reverse(NewL)). - -list2rname1([{ptype,H1},_H2|_T]) -> - [H1]; -list2rname1([H1,H2|T]) -> - [H1,"_",list2name([H2|T])]; -list2rname1([{ptype,H}|_T]) -> - [H]; -list2rname1([H|_T]) -> - [H]; -list2rname1([]) -> - []. - - - -constructed_suffix(_,#'SEQUENCE'{pname=Ptypename}) when Ptypename =/= false -> - {ptype, Ptypename}; -constructed_suffix(_,#'SET'{pname=Ptypename}) when Ptypename =/= false -> - {ptype,Ptypename}; -constructed_suffix('SEQUENCE OF',_) -> - 'SEQOF'; -constructed_suffix('SET OF',_) -> - 'SETOF'. - -erule(ber) -> - ber; -erule(ber_bin) -> - ber; -erule(ber_bin_v2) -> - ber_bin_v2; -erule(per) -> - per; -erule(per_bin) -> - per. - -wrap_ber(ber) -> - ber_bin; -wrap_ber(Erule) -> - Erule. - -rt2ct_suffix() -> - Options = get(encoding_options), - case {lists:member(optimize,Options),lists:member(per_bin,Options)} of - {true,true} -> "_rt2ct"; - _ -> "" - end. -rt2ct_suffix(per_bin) -> - Options = get(encoding_options), - case lists:member(optimize,Options) of - true -> "_rt2ct"; - _ -> "" - end; -rt2ct_suffix(_) -> "". - -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V; - {value,Cnstr} -> - Cnstr - end. |