diff options
Diffstat (limited to 'lib/asn1/src/asn1ct_gen.erl')
| -rw-r--r-- | lib/asn1/src/asn1ct_gen.erl | 648 |
1 files changed, 209 insertions, 439 deletions
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 64a3555f62..9095e145a3 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. %% %% 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 @@ -21,15 +21,9 @@ -include("asn1_records.hrl"). --export([pgen_exports/3, - pgen_hrl/5, - gen_head/3, - demit/1, +-export([demit/1, emit/1, 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, @@ -37,22 +31,19 @@ gen_check_call/7, get_constraint/2, insert_once/2, - rt2ct_suffix/1, - rt2ct_suffix/0, + ct_gen_module/1, index2suffix/1, get_record_name_prefix/0]). -export([pgen/5, - pgen_module/6, mk_var/1, un_hyphen_var/1]). -export([gen_encode_constructed/4, gen_decode_constructed/4]). --export([nif_parameter/0]). %% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% 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 +%% Erules = per | ber %% Module = atom() %% TypeOrVal = {TypeList,ValueList} %% TypeList = ValueList = [atom()] @@ -77,23 +68,28 @@ pgen_module(OutFile,Erules,Module, HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), - Fid = fopen(ErlFile,[write]), + Fid = fopen(ErlFile), put(gen_file_out,Fid), + asn1ct_func:start_link(), gen_head(Erules,Module,HrlGenerated), pgen_exports(Erules,Module,TypeOrVal), pgen_dispatcher(Erules,Module,TypeOrVal), pgen_info(), - pgen_typeorval(wrap_ber(Erules),Module,N2nConvEnums,TypeOrVal), + pgen_typeorval(Erules,Module,N2nConvEnums,TypeOrVal), pgen_partial_incomplete_decode(Erules), % gen_vars(asn1_db:mod_to_vars(Module)), % gen_tag_table(AllTypes), + emit([nl, + "%%%",nl, + "%%% Run-time functions.",nl, + "%%%",nl]), + asn1ct_func:generate(Fid), file:close(Fid), asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). pgen_typeorval(Erules,Module,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), pgen_types(Rtmod,Erules,N2nConvEnums,Module,Types), pgen_values(Erules,Module,Values), pgen_objects(Rtmod,Erules,Module,Objects), @@ -112,8 +108,7 @@ pgen_values(Erules,Module,[H|T]) -> gen_value(Valuedef), pgen_values(Erules,Module,T). -pgen_types(_,_,_,Module,[]) -> - gen_value_match(Module), +pgen_types(_, _, _, _, []) -> true; pgen_types(Rtmod,Erules,N2nConvEnums,Module,[H|T]) -> asn1ct_name:clear(), @@ -196,7 +191,7 @@ pgen_check_defaultval(Erules,Module) -> end, gen_check_defaultval(Erules,Module,CheckObjects). -pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber_bin_v2 -> +pgen_partial_decode(Rtmod,Erule,Module) when Erule == ber -> pgen_partial_inc_dec(Rtmod,Erule,Module), pgen_partial_dec(Rtmod,Erule,Module); pgen_partial_decode(_,_,_) -> @@ -240,7 +235,7 @@ pgen_partial_inc_dec1(Rtmod,Erules,Module,[P|Ps]) -> pgen_partial_inc_dec1(_,_,_,[]) -> ok. -gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber_bin_v2 -> +gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber -> case asn1ct:next_refed_func() of [] -> ok; @@ -296,8 +291,7 @@ pgen_partial_types1(_,undefined) -> %% TypeList a decode function will be generated. traverse_type_structure(Erules,Type,[],FuncName,TopTypeName) -> %% this is the selected type - Ctmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Ctmod = ct_gen_module(Erules), TypeDef = case Type of #type{} -> @@ -457,7 +451,7 @@ pgen_partial_incomplete_decode(Erule) -> _ -> ok end. -pgen_partial_incomplete_decode1(ber_bin_v2) -> +pgen_partial_incomplete_decode1(ber) -> case asn1ct:read_config_data(partial_incomplete_decode) of undefined -> ok; @@ -531,7 +525,8 @@ gen_part_decode_funcs({constructed,bif},TypeName, {_Name,parts,Tag,_Type}) -> emit([" case Data of",nl, " L when is_list(L) ->",nl, - " 'dec_",TypeName,"'(lists:map(fun(X)->element(1,?RT_BER:decode(X)) end,L),",{asis,Tag},");",nl, + " 'dec_",TypeName,"'(lists:map(fun(X) -> element(1, ", + {call,ber,ber_decode_erlang,["X"]},") end, L),",{asis,Tag},");",nl, " _ ->",nl, " [Res] = 'dec_",TypeName,"'([Data],",{asis,Tag},"),",nl, " Res",nl, @@ -552,20 +547,17 @@ gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) -> gen_types(Erules,Tname,{RootL1,ExtList,RootL2}) when is_list(RootL1), is_list(RootL2) -> gen_types(Erules,Tname,RootL1), - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), gen_types(Erules,Tname,Rtmod:extaddgroup2sequence(ExtList)), gen_types(Erules,Tname,RootL2); gen_types(Erules,Tname,{RootList,ExtList}) when is_list(RootList) -> gen_types(Erules,Tname,RootList), - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(Erules), gen_types(Erules,Tname,Rtmod:extaddgroup2sequence(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)])), + Rtmod = ct_gen_module(Erules), asn1ct_name:clear(), Rtmod:gen_encode(Erules,Tname,ComponentType), asn1ct_name:clear(), @@ -574,29 +566,12 @@ gen_types(Erules,Tname,[ComponentType|Rest]) -> gen_types(_,_,[]) -> true; gen_types(Erules,Tname,Type) when is_record(Type,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), - rt2ct_suffix(Erules)])), + Rtmod = ct_gen_module(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); @@ -658,9 +633,13 @@ gen_check_sof(Name,SOF,Type) -> end, emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}). +gen_check_sequence(Name, []) -> + emit([{asis,ensure_atom(Name)},"(_,_) ->",nl, + " throw(badval).",nl,nl]); gen_check_sequence(Name,Components) -> emit([{asis,ensure_atom(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 = ["element(",Num+1,",DefaultValue)"], @@ -672,9 +651,7 @@ gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> _ -> emit({",",nl}), gen_check_sequence(Name,Cs,Num+1) - end; -gen_check_sequence(_,[],_) -> - ok. + end. gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]), @@ -754,8 +731,7 @@ gen_value(Value) when is_record(Value,valuedef) -> emit([{asis,V},".",nl,nl]). gen_encode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) -> - - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), + Rtmod = ct_constructed_module(Erules), case InnerType of 'SET' -> Rtmod:gen_encode_set(Erules,Typename,D), @@ -787,7 +763,7 @@ gen_encode_constructed(Erules,Typename,InnerType,D) gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec). gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) -> - Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), + Rtmod = ct_constructed_module(Erules), asn1ct:step_in_constructed(), %% updates namelist for exclusive decode case InnerType of 'SET' -> @@ -810,7 +786,7 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) -> pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> - emit({"-export([encoding_rule/0]).",nl}), + emit(["-export([encoding_rule/0,bit_string_format/0]).",nl]), case Types of [] -> ok; _ -> @@ -818,27 +794,11 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> 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 + gen_exports1(Types,"dec_",2) end, case [X || {n2n,X} <- get(encoding_options)] of [] -> ok; @@ -863,16 +823,11 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) -> gen_exports1(Objects,"enc_",3), emit({"-export([",nl}), gen_exports1(Objects,"dec_",4); - ber_bin_v2 -> + ber -> 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) + gen_exports1(Objects,"dec_",3) end end, case ObjectSets of @@ -941,27 +896,25 @@ gen_selected_decode_exports1([{FuncName,_}|Rest]) -> gen_selected_decode_exports1(Rest). pgen_dispatcher(Erules,_Module,{[],_Values,_,_,_Objects,_ObjectSets}) -> - emit(["encoding_rule() ->",nl]), - emit([{asis,Erules},".",nl,nl]); + gen_info_functions(Erules); 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]), + emit(["-export([encode/2,decode/2]).",nl,nl]), + gen_info_functions(Erules), NoFinalPadding = lists:member(no_final_padding,get(encoding_options)), - 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)"; - uper_bin when NoFinalPadding == true -> - "?RT_PER:complete_NFP(encode_disp(Type,Data))"; - uper_bin -> ["?RT_PER:complete(encode_disp(Type,Data))"] - end, - EncWrap = case Erules of - ber -> "wrap_encode(Bytes)"; - _ -> "Bytes" - end, + {Call,BytesAsBinary} = + case Erules of + per -> + asn1ct_func:need({Erules,complete,1}), + {["complete(encode_disp(Type, Data))"],"Bytes"}; + ber -> + {"encode_disp(Type,Data)","iolist_to_binary(Bytes)"}; + uper when NoFinalPadding == true -> + asn1ct_func:need({Erules,complete_NFP,1}), + {"complete_NFP(encode_disp(Type, Data))","Bytes"}; + uper -> + asn1ct_func:need({Erules,complete,1}), + {["complete(encode_disp(Type, Data))"],"Bytes"} + end, emit(["encode(Type,Data) ->",nl, "case catch ",Call," of",nl, " {'EXIT',{error,Reason}} ->",nl, @@ -969,53 +922,33 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {'EXIT',Reason} ->",nl, " {error,{asn1,Reason}};",nl, " {Bytes,_Len} ->",nl, - " {ok,",EncWrap,"};",nl]), - case Erules of - per -> - emit([" Bytes when is_binary(Bytes) ->",nl, - " {ok,binary_to_list(Bytes)};",nl, - " Bytes ->",nl, - " {ok,binary_to_list(list_to_binary(Bytes))}",nl, - " end.",nl,nl]); - _ -> - emit([" Bytes ->",nl, - " {ok,",EncWrap,"}",nl, - "end.",nl,nl]) - end, - -% case Erules of -% ber_bin_v2 -> -% emit(["decode(Type,Data0) ->",nl]), -% emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",nif_parameter(),"),",nl]); -% _ -> -% emit(["decode(Type,Data) ->",nl]) -% end, + " {ok,",BytesAsBinary,"};",nl, + " Bytes ->",nl, + " {ok,",BytesAsBinary,"}",nl, + "end.",nl,nl]), Return_rest = lists:member(undec_rest,get(encoding_options)), Data = case {Erules,Return_rest} of - {ber_bin_v2,true} -> "Data0"; + {ber,true} -> "Data0"; _ -> "Data" end, emit(["decode(Type,",Data,") ->",nl]), DecAnonymous = case {Erules,Return_rest} of - {ber_bin_v2,false} -> - io_lib:format("~s~s~s~n", - ["element(1,?RT_BER:decode(Data", - nif_parameter(),"))"]); - {ber_bin_v2,true} -> - emit(["{Data,Rest} = ?RT_BER:decode(Data0", - nif_parameter(),"),",nl]), + {ber,false} -> + asn1ct_func:need({ber,ber_decode_nif,1}), + "element(1, ber_decode_nif(Data))"; + {ber,true} -> + asn1ct_func:need({ber,ber_decode_nif,1}), + emit(["{Data,Rest} = ber_decode_nif(Data0),",nl]), "Data"; _ -> "Data" end, DecWrap = case Erules of - ber -> "wrap_decode(Data)"; - ber_bin_v2 -> + ber -> DecAnonymous; - per -> "list_to_binary(Data)"; _ -> "Data" end, @@ -1025,32 +958,18 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {'EXIT',Reason} ->",nl, " {error,{asn1,Reason}};",nl]), case {Erules,Return_rest} of - {ber_bin_v2,false} -> + {ber,false} -> emit([" Result ->",nl, " {ok,Result}",nl]); - {ber_bin_v2,true} -> + {ber,true} -> emit([" Result ->",nl, " {ok,Result,Rest}",nl]); - {per,false} -> - emit([" {X,_Rest} ->",nl, - " {ok,if_binary2list(X)};",nl, - " {X,_Rest,_Len} ->",nl, - " {ok,if_binary2list(X)}",nl]); {_,false} -> emit([" {X,_Rest} ->",nl, " {ok,X};",nl, " {X,_Rest,_Len} ->",nl, " {ok,X}",nl]); - {per,true} -> - emit([" {X,{_,Rest}} ->",nl, - " {ok,if_binary2list(X),Rest};",nl, - " {X,{_,Rest},_Len} ->",nl, - " {ok,if_binary2list(X),Rest};",nl, - " {X,Rest} ->",nl, - " {ok,if_binary2list(X),Rest};",nl, - " {X,Rest,_Len} ->",nl, - " {ok,if_binary2list(X),Rest}",nl]); - {per_bin,true} -> + {per,true} -> emit([" {X,{_,Rest}} ->",nl, " {ok,X,Rest};",nl, " {X,{_,Rest},_Len} ->",nl, @@ -1059,7 +978,7 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {ok,X,Rest};",nl, " {X,Rest,_Len} ->",nl, " {ok,X,Rest}",nl]); - {uper_bin,true} -> + {uper,true} -> emit([" {X,{_,Rest}} ->",nl, " {ok,X,Rest};",nl, " {X,{_,Rest},_Len} ->",nl, @@ -1067,34 +986,14 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> " {X,Rest} ->",nl, " {ok,X,Rest};",nl, " {X,Rest,_Len} ->",nl, - " {ok,X,Rest}",nl]); - _ -> - emit([" {X,Rest} ->",nl, - " {ok,X,Rest};",nl, - " {X,Rest,_Len} ->",nl, " {ok,X,Rest}",nl]) end, emit(["end.",nl,nl]), - case Erules of - per -> - emit(["if_binary2list(B) when is_binary(B) ->",nl, - " binary_to_list(B);",nl, - "if_binary2list(L) -> L.",nl,nl]); - _ -> - ok - end, - gen_decode_partial_incomplete(Erules), 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(); @@ -1103,17 +1002,15 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> gen_dispatcher(Types,"decode_disp","dec_",",mandatory") end, emit([nl]), - - case Erules of - ber -> - gen_wrapper(); - _ -> ok - end, emit({nl,nl}). +gen_info_functions(Erules) -> + emit(["encoding_rule() -> ", + {asis,Erules},".",nl,nl, + "bit_string_format() -> ", + {asis,asn1ct:get_bit_string_format()},".",nl,nl]). -gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; - Erule==ber_bin_v2 -> +gen_decode_partial_incomplete(ber) -> case {asn1ct:read_config_data(partial_incomplete_decode), asn1ct:get_gen_state_field(inc_type_pattern)} of {undefined,_} -> @@ -1121,34 +1018,35 @@ gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; {_,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]), - emit([" case catch decode_inc_disp(Type,element(1," - "?RT_BER:decode(Data0",nif_parameter(),"))) of",nl]), -% " {Data,_RestBin} = ?RT_BER:decode(Data0),",nl, -% " case catch decode_inc_disp(Type,Data) of",nl]), - EmitCaseClauses(); - _ -> ok % add later - end + EmitCaseClauses = + fun() -> + emit([" {'EXIT',{error,Reason}} ->",nl, + " {error,Reason};",nl, + " {'EXIT',Reason} ->",nl, + " {error,{asn1,Reason}};",nl, + " Result ->",nl, + " {ok,Result}",nl, + " end"]) + end, + emit(["decode_partial_incomplete(Type,Data0,", + "Pattern) ->",nl]), + emit([" {Data,_RestBin} =",nl, + " ",{call,ber,decode_primitive_incomplete, + ["Pattern","Data0"]},com,nl, + " case catch decode_partial_inc_disp(Type,", + "Data) of",nl]), + EmitCaseClauses(), + emit([".",nl,nl]), + emit(["decode_part(Type, Data0) " + "when is_binary(Data0) ->",nl]), + emit([" case catch decode_inc_disp(Type,element(1, ", + {call,ber,ber_decode_nif,["Data0"]},")) of",nl]), + EmitCaseClauses(), + emit([";",nl]), + emit(["decode_part(Type, Data0) ->",nl]), + emit([" case catch decode_inc_disp(Type, Data0) of",nl]), + EmitCaseClauses(), + emit([".",nl,nl]) end; gen_decode_partial_incomplete(_Erule) -> ok. @@ -1186,24 +1084,6 @@ gen_partial_inc_dispatcher([],_) -> emit(["decode_partial_inc_disp(Type,_Data) ->",nl, " exit({error,{asn1,{undefined_type,Type}}}).",nl]). -nif_parameter() -> - Options = get(encoding_options), - case {lists:member(driver,Options),lists:member(nif,Options)} of - {true,_} -> ",nif"; - {_,true} -> ",nif"; - _ -> "" - end. - -gen_wrapper() -> - emit(["wrap_encode(Bytes) when is_list(Bytes) ->",nl, - " binary_to_list(list_to_binary(Bytes));",nl, - "wrap_encode(Bytes) when is_binary(Bytes) ->",nl, - " binary_to_list(Bytes);",nl, - "wrap_encode(Bytes) -> Bytes.",nl,nl]), - emit(["wrap_decode(Bytes) when is_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); @@ -1213,24 +1093,21 @@ gen_dispatcher([Flast|_T],FuncName,Prefix,ExtraArg) -> pgen_info() -> emit(["info() ->",nl, - " case ?MODULE:module_info() of",nl, - " MI when is_list(MI) ->",nl, - " case lists:keysearch(attributes,1,MI) of",nl, - " {value,{_,Attributes}} when is_list(Attributes) ->",nl, - " case lists:keysearch(asn1_info,1,Attributes) of",nl, - " {value,{_,Info}} when is_list(Info) ->",nl, - " Info;",nl, - " _ ->",nl, - " []",nl, - " end;",nl, - " _ ->",nl, - " []",nl, - " end",nl, + " case ?MODULE:module_info(attributes) of",nl, + " Attributes when is_list(Attributes) ->",nl, + " case lists:keyfind(asn1_info, 1, Attributes) of",nl, + " {_,Info} when is_list(Info) ->",nl, + " Info;",nl, + " _ ->",nl, + " []",nl, + " end;",nl, + " _ ->",nl, + " []",nl, " end.",nl]). open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), - Fid = fopen(File,[write]), + Fid = fopen(File), put(gen_file_out,Fid), gen_hrlhead(Module). @@ -1245,77 +1122,67 @@ demit(Term) -> end. % always generation +emit(Term) -> + ok = file:write(get(gen_file_out), do_emit(Term)). -emit({external,_M,T}) -> - emit(T); +do_emit({external,_M,T}) -> + do_emit(T); -emit({prev,Variable}) when is_atom(Variable) -> - emit({var,asn1ct_name:prev(Variable)}); +do_emit({prev,Variable}) when is_atom(Variable) -> + do_emit({var,asn1ct_name:prev(Variable)}); -emit({next,Variable}) when is_atom(Variable) -> - emit({var,asn1ct_name:next(Variable)}); +do_emit({next,Variable}) when is_atom(Variable) -> + do_emit({var,asn1ct_name:next(Variable)}); -emit({curr,Variable}) when is_atom(Variable) -> - emit({var,asn1ct_name:curr(Variable)}); +do_emit({curr,Variable}) when is_atom(Variable) -> + do_emit({var,asn1ct_name:curr(Variable)}); -emit({var,Variable}) when is_atom(Variable) -> +do_emit({var,Variable}) when is_atom(Variable) -> [Head|V] = atom_to_list(Variable), - emit([Head-32|V]); + [Head-32|V]; -emit({var,Variable}) -> +do_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)); + [Head-32|V]; -emit(com) -> - emit(","); +do_emit({asis,What}) -> + io_lib:format("~w", [What]); -emit(tab) -> - put_chars(get(gen_file_out)," "); +do_emit({call,M,F,A}) -> + MFA = {M,F,length(A)}, + asn1ct_func:need(MFA), + [atom_to_list(F),"(",call_args(A, "")|")"]; -emit(What) when is_integer(What) -> - put_chars(get(gen_file_out),integer_to_list(What)); +do_emit(nl) -> + "\n"; -emit(What) when is_list(What), is_integer(hd(What)) -> - put_chars(get(gen_file_out),What); +do_emit(com) -> + ","; -emit(What) when is_atom(What) -> - put_chars(get(gen_file_out),atom_to_list(What)); +do_emit(tab) -> + " "; -emit(What) when is_tuple(What) -> - emit_parts(tuple_to_list(What)); +do_emit(What) when is_integer(What) -> + integer_to_list(What); -emit(What) when is_list(What) -> - emit_parts(What); +do_emit(What) when is_list(What), is_integer(hd(What)) -> + What; -emit(X) -> - exit({'cant emit ',X}). +do_emit(What) when is_atom(What) -> + atom_to_list(What); -emit_parts([]) -> true; -emit_parts([H|T]) -> - emit(H), - emit_parts(T). +do_emit(What) when is_tuple(What) -> + [do_emit(E) || E <- tuple_to_list(What)]; -format(undefined,X,Y) -> - io:format(X,Y); -format(X,Y,Z) -> - io:format(X,Y,Z). +do_emit(What) when is_list(What) -> + [do_emit(E) || E <- What]. -nl(undefined) -> io:nl(); -nl(X) -> io:nl(X). +call_args([A|As], Sep) -> + [Sep,do_emit(A)|call_args(As, ", ")]; +call_args([], _) -> []. -put_chars(undefined,X) -> - io:put_chars(X); -put_chars(Y,X) -> - io:put_chars(Y,X). - -fopen(F, ModeList) -> - case file:open(F, ModeList) of +fopen(F) -> + case file:open(F, [write,raw,delayed_write]) of {ok, Fd} -> Fd; {error, Reason} -> @@ -1493,55 +1360,31 @@ gen_record(_,_,_,NumRecords) -> % skip CLASS etc for now. gen_head(Erules,Mod,Hrl) -> Options = get(encoding_options), - {Rtmac,Rtmod} = case Erules of - per -> - emit({"%% Generated by the Erlang ASN.1 PER-" - "compiler version:",asn1ct:vsn(),nl}), - {"RT_PER",?RT_PER_BIN}; - 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 - 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"}; - uper_bin -> - emit(["%% Generated by the Erlang ASN.1 UNALIGNED" - " PER-compiler version, utilizing" - " bit-syntax:", - asn1ct:vsn(),nl]), - {"RT_PER","asn1rt_uper_bin"} + case Erules of + per -> + emit(["%% Generated by the Erlang ASN.1 PER-" + "compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]); + ber -> + emit(["%% Generated by the Erlang ASN.1 BER_V2-" + "compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]); + uper -> + emit(["%% Generated by the Erlang ASN.1 UNALIGNED" + " PER-compiler version, utilizing bit-syntax:", + asn1ct:vsn(),nl]) 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,lists:member(inline,get(encoding_options))} of - {0,_} -> true; - {_,true} -> true; - _ -> - emit({"-include(\"",Mod,".hrl\").",nl}) + emit({"-compile(nowarn_unused_vars).",nl}), + case Hrl of + 0 -> ok; + _ -> emit({"-include(\"",Mod,".hrl\").",nl}) end, - emit(["-define('",Rtmac,"',",Rtmod,").",nl]), emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl, " {module,'",Mod,"'},",nl, - " {options,",io_lib:format("~w",[Options]),"}]).",nl,nl]). + " {options,",io_lib:format("~p",[Options]),"}]).",nl,nl]). gen_hrlhead(Mod) -> @@ -1619,50 +1462,41 @@ gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) -> emit(["fun() -> true end ()"]) end. -gen_prim_check_call(PrimType,DefaultValue,Element,Type) -> +gen_prim_check_call(PrimType, Default, Element, Type) -> case unify_if_string(PrimType) of 'BOOLEAN' -> - emit({"asn1rt_check:check_bool(",DefaultValue,", ", - Element,")"}); + check_call(check_bool, [Default,Element]); 'INTEGER' -> - NNL = - case Type#type.def of - {_,NamedNumberList} -> NamedNumberList; - _ -> [] - end, - emit({"asn1rt_check:check_int(",DefaultValue,", ", - Element,", ",{asis,NNL},")"}); + NNL = case Type#type.def of + {_,NamedNumberList} -> NamedNumberList; + _ -> [] + end, + check_call(check_int, [Default,Element,{asis,NNL}]); 'BIT STRING' -> {_,NBL} = Type#type.def, - emit({"asn1rt_check:check_bitstring(",DefaultValue,", ", - Element,", ",{asis,NBL},")"}); + check_call(check_bitstring, [Default,Element,{asis,NBL}]); 'OCTET STRING' -> - emit({"asn1rt_check:check_octetstring(",DefaultValue,", ", - Element,")"}); + check_call(check_octetstring, [Default,Element]); 'NULL' -> - emit({"asn1rt_check:check_null(",DefaultValue,", ", - Element,")"}); + check_call(check_null, [Default,Element]); 'OBJECT IDENTIFIER' -> - emit({"asn1rt_check:check_objectidentifier(",DefaultValue, - ", ",Element,")"}); + check_call(check_objectidentifier, [Default,Element]); 'RELATIVE-OID' -> - emit({"asn1rt_check:check_objectidentifier(",DefaultValue, - ", ",Element,")"}); + check_call(check_objectidentifier, [Default,Element]); 'ObjectDescriptor' -> - emit({"asn1rt_check:check_objectdescriptor(",DefaultValue, - ", ",Element,")"}); + check_call(check_objectdescriptor, [Default,Element]); 'REAL' -> - emit({"asn1rt_check:check_real(",DefaultValue, - ", ",Element,")"}); + check_call(check_real, [Default,Element]); 'ENUMERATED' -> {_,Enumerations} = Type#type.def, - emit({"asn1rt_check:check_enum(",DefaultValue, - ", ",Element,", ",{asis,Enumerations},")"}); + check_call(check_enum, [Default,Element,{asis,Enumerations}]); restrictedstring -> - emit({"asn1rt_check:check_restrictedstring(",DefaultValue, - ", ",Element,")"}) + check_call(check_restrictedstring, [Default,Element]) end. +check_call(F, Args) -> + asn1ct_func:call(check, F, Args). + %% 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) -> @@ -1800,7 +1634,6 @@ unify_if_string(PrimType) -> get_inner(A) when is_atom(A) -> A; get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext; -get_inner(Tref) when is_record(Tref,typereference) -> Tref; get_inner({fixedtypevaluefield,_,Type}) -> if is_record(Type,type) -> @@ -1833,8 +1666,6 @@ get_inner(T) when is_tuple(T) -> type(X) when is_record(X,'Externaltypereference') -> X; -type(X) when is_record(X,typereference) -> - X; type('ASN1_OPEN_TYPE') -> 'ASN1_OPEN_TYPE'; type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) -> @@ -1842,15 +1673,6 @@ type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) -> 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}; @@ -1869,7 +1691,6 @@ prim_bif(X) -> 'REAL', 'OBJECT IDENTIFIER', 'RELATIVE-OID', - 'ANY', 'NULL', 'BIT STRING' , 'OCTET STRING' , @@ -1913,15 +1734,6 @@ def_to_tag(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) -> @@ -1937,34 +1749,6 @@ get_fieldtype([Field|Rest],FieldName) -> 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 is_record(Type,type) -> - case Type#type.def of - {{objectclass,_,_},TypeFrObj} when is_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 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2019,43 +1803,29 @@ constructed_suffix('SEQUENCE OF',_) -> 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; -erule(uper_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(_) -> "". +erule(ber) -> ber; +erule(per) -> per; +erule(uper) -> per. index2suffix(0) -> ""; index2suffix(N) -> lists:concat(["_",N]). +ct_gen_module(ber) -> + asn1ct_gen_ber_bin_v2; +ct_gen_module(per) -> + asn1ct_gen_per; +ct_gen_module(uper) -> + asn1ct_gen_per. + +ct_constructed_module(ber) -> + asn1ct_constructed_ber_bin_v2; +ct_constructed_module(per) -> + asn1ct_constructed_per; +ct_constructed_module(uper) -> + asn1ct_constructed_per. + get_constraint(C,Key) -> case lists:keysearch(Key,1,C) of false -> |