aboutsummaryrefslogtreecommitdiffstats
path: root/lib/asn1/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/asn1/src')
-rw-r--r--lib/asn1/src/Makefile5
-rw-r--r--lib/asn1/src/asn1_db.erl116
-rw-r--r--lib/asn1/src/asn1ct.erl69
-rw-r--r--lib/asn1/src/asn1ct_check.erl67
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl46
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl1125
-rw-r--r--lib/asn1/src/asn1ct_eval_per.funcs2
-rw-r--r--lib/asn1/src/asn1ct_eval_uper.funcs2
-rw-r--r--lib/asn1/src/asn1ct_func.erl65
-rw-r--r--lib/asn1/src/asn1ct_gen.erl53
-rw-r--r--lib/asn1/src/asn1ct_gen_ber_bin_v2.erl38
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl921
-rw-r--r--lib/asn1/src/asn1ct_gen_per_rt2ct.erl461
-rw-r--r--lib/asn1/src/asn1ct_imm.erl1470
-rw-r--r--lib/asn1/src/asn1ct_value.erl8
-rw-r--r--lib/asn1/src/asn1rtt_ber.erl3
-rw-r--r--lib/asn1/src/asn1rtt_per.erl876
-rw-r--r--lib/asn1/src/asn1rtt_per_common.erl333
-rw-r--r--lib/asn1/src/asn1rtt_real_common.erl6
-rw-r--r--lib/asn1/src/asn1rtt_uper.erl915
20 files changed, 2758 insertions, 3823 deletions
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile
index 33cd3cc4c3..3f24e15c04 100644
--- a/lib/asn1/src/Makefile
+++ b/lib/asn1/src/Makefile
@@ -43,9 +43,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/asn1-$(VSN)
EBIN = ../ebin
-EVAL_CT_MODULES = asn1ct_eval_ext \
- asn1ct_eval_per \
- asn1ct_eval_uper
+EVAL_CT_MODULES = asn1ct_eval_ext
CT_MODULES= \
asn1ct \
@@ -55,7 +53,6 @@ CT_MODULES= \
asn1ct_func \
asn1ct_gen \
asn1ct_gen_per \
- asn1ct_gen_per_rt2ct \
asn1ct_name \
asn1ct_constructed_per \
asn1ct_constructed_ber_bin_v2 \
diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl
index 869b36ddbd..48d9dd16d7 100644
--- a/lib/asn1/src/asn1_db.erl
+++ b/lib/asn1/src/asn1_db.erl
@@ -19,25 +19,37 @@
%%
-module(asn1_db).
--export([dbstart/1,dbnew/1,dbsave/2,dbput/3,dbget/2]).
+-export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/3,dbget/2]).
-export([dbstop/0]).
-record(state, {parent, monitor, includes, table}).
%% Interface
-dbstart(Includes) ->
+dbstart(Includes0) ->
+ Includes = case Includes0 of
+ [] -> ["."];
+ [_|_] -> Includes0
+ end,
Parent = self(),
undefined = get(?MODULE), %Assertion.
put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)),
ok.
-dbnew(Module) -> req({new, Module}).
+dbload(Module, Erule, Mtime) ->
+ req({load, Module, Erule, Mtime}).
+
+dbload(Module) ->
+ req({load, Module, any, {{0,0,0},{0,0,0}}}).
+
+dbnew(Module, Erule) -> req({new, Module, Erule}).
dbsave(OutFile, Module) -> cast({save, OutFile, Module}).
dbput(Module, K, V) -> cast({set, Module, K, V}).
dbget(Module, K) -> req({get, Module, K}).
dbstop() -> Resp = req(stop), erase(?MODULE), Resp.
%% Internal functions
+-define(MAGIC_KEY, '__version_and_erule__').
+
req(Request) ->
DbPid = get(?MODULE),
Ref = erlang:monitor(process,DbPid),
@@ -71,47 +83,57 @@ loop(#state{parent = Parent, monitor = MRef, table = Table,
ets:insert(Modtab, {K2, V}),
loop(State);
{From, {get, Mod, K2}} ->
- Result = case ets:lookup(Table, Mod) of
- [] -> opentab(Table, Mod, Includes);
- [{_, Modtab}] -> {ok, Modtab}
- end,
- case Result of
- {ok, Newtab} -> reply(From, lookup(Newtab, K2));
- _Error -> reply(From, undefined)
+ %% XXX If there is no information for Mod, get_table/3
+ %% will attempt to load information from an .asn1db
+ %% file, without comparing its timestamp against the
+ %% source file. This is known to happen when check_*
+ %% functions for DER are generated, but it could possibly
+ %% happen in other circumstances. Ideally, this issue should
+ %% be rectified in some way, perhaps by ensuring that
+ %% the module has been loaded (using dbload/4) prior
+ %% to calling dbget/2.
+ case get_table(Table, Mod, Includes) of
+ {ok,Tab} -> reply(From, lookup(Tab, K2));
+ error -> reply(From, undefined)
end,
loop(State);
{save, OutFile, Mod} ->
[{_,Mtab}] = ets:lookup(Table, Mod),
ok = ets:tab2file(Mtab, OutFile),
loop(State);
- {From, {new, Mod}} ->
+ {From, {new, Mod, Erule}} ->
[] = ets:lookup(Table, Mod), %Assertion.
ModTableId = ets:new(list_to_atom(lists:concat(["asn1_",Mod])), []),
ets:insert(Table, {Mod, ModTableId}),
+ ets:insert(ModTableId, {?MAGIC_KEY, info(Erule)}),
reply(From, ok),
loop(State);
+ {From, {load, Mod, Erule, Mtime}} ->
+ case ets:member(Table, Mod) of
+ true ->
+ reply(From, ok);
+ false ->
+ case load_table(Mod, Erule, Mtime, Includes) of
+ {ok, ModTableId} ->
+ ets:insert(Table, {Mod, ModTableId}),
+ reply(From, ok);
+ error ->
+ reply(From, error)
+ end
+ end,
+ loop(State);
{From, stop} ->
reply(From, stopped); %% Nothing to store
{'DOWN', MRef, process, Parent, Reason} ->
exit(Reason)
end.
-opentab(Tab, Mod, []) ->
- opentab(Tab, Mod, ["."]);
-opentab(Tab, Mod, Includes) ->
- Base = lists:concat([Mod, ".asn1db"]),
- opentab2(Tab, Base, Mod, Includes, ok).
-
-opentab2(_Tab, _Base, _Mod, [], Error) ->
- Error;
-opentab2(Tab, Base, Mod, [Ih|It], _Error) ->
- File = filename:join(Ih, Base),
- case ets:file2tab(File) of
- {ok, Modtab} ->
- ets:insert(Tab, {Mod, Modtab}),
- {ok, Modtab};
- NewErr ->
- opentab2(Tab, Base, Mod, It, NewErr)
+get_table(Table, Mod, Includes) ->
+ case ets:lookup(Table, Mod) of
+ [{Mod,Tab}] ->
+ {ok,Tab};
+ [] ->
+ load_table(Mod, any, {{0,0,0},{0,0,0}}, Includes)
end.
lookup(Tab, K) ->
@@ -119,3 +141,43 @@ lookup(Tab, K) ->
[] -> undefined;
[{K,V}] -> V
end.
+
+info(Erule) ->
+ {asn1ct:vsn(),Erule}.
+
+load_table(Mod, Erule, Mtime, Includes) ->
+ Base = lists:concat([Mod, ".asn1db"]),
+ case path_find(Includes, Mtime, Base) of
+ error ->
+ error;
+ {ok,ModTab} when Erule =:= any ->
+ {ok,ModTab};
+ {ok,ModTab} ->
+ Vsn = asn1ct:vsn(),
+ case ets:lookup(ModTab, ?MAGIC_KEY) of
+ [{_,{Vsn,Erule}}] ->
+ %% Correct version and encoding rule.
+ {ok,ModTab};
+ _ ->
+ %% Missing key or wrong version/encoding rule.
+ ets:delete(ModTab),
+ error
+ end
+ end.
+
+path_find([H|T], Mtime, Base) ->
+ File = filename:join(H, Base),
+ case filelib:last_modified(File) of
+ 0 ->
+ path_find(T, Mtime, Base);
+ DbMtime when DbMtime >= Mtime ->
+ case ets:file2tab(File) of
+ {ok,_}=Ret ->
+ Ret;
+ _ ->
+ path_find(T, Mtime, Base)
+ end;
+ _ ->
+ path_find(T, Mtime, Base)
+ end;
+path_find([], _, _) -> error.
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index 8e71a5697c..f2ccf5f212 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -893,17 +893,23 @@ parse_and_save(Module,S) ->
Options = S#state.options,
SourceDir = S#state.sourcedir,
Includes = [I || {i,I} <- Options],
+ Erule = S#state.erule,
case get_input_file(Module, [SourceDir|Includes]) of
%% search for asn1 source
{file,SuffixedASN1source} ->
- case dbfile_uptodate(SuffixedASN1source,Options) of
- false ->
- parse_and_save1(S, SuffixedASN1source, Options);
- _ -> ok
+ Mtime = filelib:last_modified(SuffixedASN1source),
+ case asn1_db:dbload(Module, Erule, Mtime) of
+ ok -> ok;
+ error -> parse_and_save1(S, SuffixedASN1source, Options)
end;
Err ->
- warning("could not do a consistency check of the ~p file: no asn1 source file was found.~n",
- [lists:concat([Module,".asn1db"])],Options),
+ case asn1_db:dbload(Module) of
+ ok ->
+ warning("could not do a consistency check of the ~p file: no asn1 source file was found.~n",
+ [lists:concat([Module,".asn1db"])],Options);
+ error ->
+ ok
+ end,
{error,{asn1,input_file_error,Err}}
end.
@@ -929,48 +935,6 @@ get_input_file(Module,[I|Includes]) ->
get_input_file(Module,Includes)
end.
-dbfile_uptodate(File,Options) ->
- EncodingRule = get_rule(Options),
- Ext = filename:extension(File),
- Base = filename:basename(File,Ext),
- DbFile = outfile(Base,"asn1db",Options),
- case file:read_file_info(DbFile) of
- {error,enoent} ->
- false;
- {ok,FileInfoDb} ->
- %% file exists, check date and finally encodingrule
- {ok,FileInfoAsn} = file:read_file_info(File),
- case FileInfoDb#file_info.mtime < FileInfoAsn#file_info.mtime of
- true ->
- %% date of asn1 spec newer than db file
- false;
- _ ->
- %% date ok,check that same erule was used
- Obase = case lists:keysearch(outdir, 1, Options) of
- {value, {outdir, Odir}} ->
- Odir;
- _NotFound -> ""
- end,
- BeamFileName = outfile(Base,"beam",Options),
- case file:read_file_info(BeamFileName) of
- {ok,_} ->
- code:add_path(Obase),
- BeamFile = list_to_atom(Base),
- BeamInfo = (catch BeamFile:info()),
- case catch lists:keysearch(options,1,BeamInfo) of
- {value,{options,OldOptions}} ->
- case get_rule(OldOptions) of
- EncodingRule -> true;
- _ -> false
- end;
- _ -> false
- end;
- _ -> false
- end
- end
- end.
-
-
input_file_type(Name,I) ->
case input_file_type(Name) of
{error,_} -> input_file_type2(filename:basename(Name),I);
@@ -1374,10 +1338,11 @@ get_value(Module, Type) ->
end.
check(Module, Includes) ->
- case asn1_db:dbget(Module,'MODULE') of
- undefined ->
- {error, {file_not_found, lists:concat([Module, ".asn1db"])}};
- M ->
+ case asn1_db:dbload(Module) of
+ error ->
+ {error,asn1db_missing_or_out_of_date};
+ ok ->
+ M = asn1_db:dbget(Module, 'MODULE'),
TypeOrVal = M#module.typeorval,
State = #state{mname = M#module.name,
module = M#module{typeorval=[]},
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index f94550b0a4..eddcda0018 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -1557,21 +1557,32 @@ check_objectdefn(S,Def,CDef) when is_record(CDef,classdef) ->
exit({error,{objectdefn,Other}})
end.
-check_defaultfields(S,Fields,ClassFields) ->
- check_defaultfields(S,Fields,ClassFields,[]).
+check_defaultfields(S, Fields, ClassFields) ->
+ Present = ordsets:from_list([F || {F,_} <- Fields]),
+ Mandatory0 = get_mandatory_class_fields(ClassFields),
+ Mandatory = ordsets:from_list(Mandatory0),
+ All = ordsets:from_list([element(2, F) || F <- ClassFields]),
+ #state{type=T,tname=Obj} = S,
+ case ordsets:subtract(Present, All) of
+ [] ->
+ ok;
+ [_|_]=Invalid ->
+ throw(asn1_error(S, T, {invalid_fields,Invalid,Obj}))
+ end,
+ case ordsets:subtract(Mandatory, Present) of
+ [] ->
+ check_defaultfields_1(S, Fields, ClassFields, []);
+ [_|_]=Missing ->
+ throw(asn1_error(S, T, {missing_mandatory_fields,Missing,Obj}))
+ end.
-check_defaultfields(_S,[],_ClassFields,Acc) ->
+check_defaultfields_1(_S, [], _ClassFields, Acc) ->
{object,defaultsyntax,lists:reverse(Acc)};
-check_defaultfields(S,[{FName,Spec}|Fields],ClassFields,Acc) ->
- case lists:keysearch(FName,2,ClassFields) of
- {value,CField} ->
- {NewField,RestFields} =
- convert_to_defaultfield(S,FName,[Spec|Fields],CField),
- check_defaultfields(S,RestFields,ClassFields,[NewField|Acc]);
- _ ->
- throw({error,{asn1,{'unvalid field in object',FName}}})
- end.
-%% {object,defaultsyntax,Fields}.
+check_defaultfields_1(S, [{FName,Spec}|Fields], ClassFields, Acc) ->
+ CField = lists:keyfind(FName, 2, ClassFields),
+ {NewField,RestFields} =
+ convert_to_defaultfield(S, FName, [Spec|Fields], CField),
+ check_defaultfields_1(S, RestFields, ClassFields, [NewField|Acc]).
convert_definedsyntax(_S,[],[],_ClassFields,Acc) ->
lists:reverse(Acc);
@@ -1587,6 +1598,23 @@ convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) ->
[MatchedField|Acc])
end.
+get_mandatory_class_fields([{fixedtypevaluefield,Name,_,_,'MANDATORY'}|T]) ->
+ [Name|get_mandatory_class_fields(T)];
+get_mandatory_class_fields([{objectfield,Name,_,_,'MANDATORY'}|T]) ->
+ [Name|get_mandatory_class_fields(T)];
+get_mandatory_class_fields([{objectsetfield,Name,_,'MANDATORY'}|T]) ->
+ [Name|get_mandatory_class_fields(T)];
+get_mandatory_class_fields([{typefield,Name,'MANDATORY'}|T]) ->
+ [Name|get_mandatory_class_fields(T)];
+get_mandatory_class_fields([{variabletypevaluefield,Name,_,'MANDATORY'}|T]) ->
+ [Name|get_mandatory_class_fields(T)];
+get_mandatory_class_fields([{variabletypevaluesetfield,
+ Name,_,'MANDATORY'}|T]) ->
+ [Name|get_mandatory_class_fields(T)];
+get_mandatory_class_fields([_|T]) ->
+ get_mandatory_class_fields(T);
+get_mandatory_class_fields([]) -> [].
+
match_field(S,Fields,WithSyntax,ClassFields) ->
match_field(S,Fields,WithSyntax,ClassFields,[]).
@@ -6798,7 +6826,7 @@ merge_tags2([], Acc) ->
storeindb(S,M) when is_record(M,module) ->
TVlist = M#module.typeorval,
NewM = M#module{typeorval=findtypes_and_values(TVlist)},
- asn1_db:dbnew(NewM#module.name),
+ asn1_db:dbnew(NewM#module.name, S#state.erule),
asn1_db:dbput(NewM#module.name,'MODULE', NewM),
Res = storeindb(#state{mname=NewM#module.name}, TVlist, []),
include_default_class(S,NewM#module.name),
@@ -6867,11 +6895,22 @@ asn1_error(#state{mname=Where}, Item, Error) ->
format_error({already_defined,Name,PrevLine}) ->
io_lib:format("the name ~p has already been defined at line ~p",
[Name,PrevLine]);
+format_error({invalid_fields,Fields,Obj}) ->
+ io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]);
+format_error({missing_mandatory_fields,Fields,Obj}) ->
+ io_lib:format("missing mandatory ~s in ~p",
+ [format_fields(Fields),Obj]);
format_error({undefined,Name}) ->
io_lib:format("'~s' is referenced, but is not defined", [Name]);
format_error(Other) ->
io_lib:format("~p", [Other]).
+format_fields([F]) ->
+ io_lib:format("field &~s", [F]);
+format_fields([H|T]) ->
+ [io_lib:format("fields &~s", [H])|
+ [io_lib:format(", &~s", [F]) || F <- T]].
+
error({_,{structured_error,_,_,_}=SE,_}) ->
SE;
error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
index 761faa53c5..8359b81b33 100644
--- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
@@ -122,8 +122,8 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) ->
asn1ct_gen:un_hyphen_var(lists:concat(['Obj',
AttrN])),
emit([ObjectEncode," = ",nl,
- " ",{asis,ObjSetMod},":'getenc_",ObjSetName,
- "'(",{asis,UniqueFieldName},", ",nl]),
+ " ",{asis,ObjSetMod},":'getenc_",ObjSetName,
+ "'("]),
ValueMatch = value_match(ValueIndex,
lists:concat(["Cindex",N])),
emit([indent(35),ValueMatch,"),",nl]),
@@ -198,7 +198,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:new(tlv),
asn1ct_name:new(v),
- {DecObjInf,UniqueFName,ValueIndex} =
+ {DecObjInf,ValueIndex} =
case TableConsInfo of
#simpletableattributes{objectsetname=ObjectSetRef,
c_name=AttrN,
@@ -217,12 +217,12 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
%% relation from a component to another components
%% subtype component
{{AttrN,{deep,ObjectSetRef,UniqueFieldName,ValIndex}},
- UniqueFieldName,ValIndex};
+ ValIndex};
false ->
- {{AttrN,ObjectSetRef},UniqueFieldName,ValIndex}
+ {{AttrN,ObjectSetRef},ValIndex}
end;
_ ->
- {false,false,false}
+ {false,false}
end,
RecordName = lists:concat([get_record_name_prefix(),
asn1ct_gen:list2rname(Typename)]),
@@ -246,7 +246,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
{ObjSetMod,ObjSetName} = ObjSetRef,
emit([DecObj," =",nl,
" ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,"),",nl]),
+ ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
demit(["Result = "]), %dbg
@@ -357,7 +357,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:new(v),
- {DecObjInf,UniqueFName,ValueIndex} =
+ {DecObjInf,ValueIndex} =
case TableConsInfo of
%% {ObjectSetRef,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint
#simpletableattributes{objectsetname=ObjectSetRef,
@@ -378,12 +378,12 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
%% relation from a component to another components
%% subtype component
{{AttrN,{deep,ObjectSetRef,UniqueFieldName,ValIndex}},
- UniqueFieldName,ValIndex};
+ ValIndex};
false ->
- {{AttrN,ObjectSetRef},UniqueFieldName,ValIndex}
+ {{AttrN,ObjectSetRef},ValIndex}
end;
_ ->
- {false,false,false}
+ {false,false}
end,
case CompList of
@@ -425,7 +425,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
{ObjSetMod,ObjSetName} = ObjSetRef,
emit([DecObj," =",nl,
" ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,"),",nl]),
+ ValueMatch,"),",nl]),
gen_dec_postponed_decs(DecObj,PostponedDecArgs)
end,
demit(["Result = "]), %dbg
@@ -577,6 +577,8 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
gen_enc_sequence_call(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type,prop=Prop,textual_order=Order}|Rest],Pos,Ext,EncObj) ->
asn1ct_name:new(encBytes),
asn1ct_name:new(encLen),
+ asn1ct_name:new(tmpBytes),
+ asn1ct_name:new(tmpLen),
CindexPos =
case Order of
undefined ->
@@ -706,8 +708,6 @@ emit_term_tlv('OPTIONAL',InnerType,DecObjInf) ->
emit_term_tlv(opt_or_def,InnerType,DecObjInf);
emit_term_tlv(Prop,{typefield,_},DecObjInf) ->
emit_term_tlv(Prop,type_or_object_field,DecObjInf);
-emit_term_tlv(Prop,{objectfield,_,_},DecObjInf) ->
- emit_term_tlv(Prop,type_or_object_field,DecObjInf);
emit_term_tlv(opt_or_def,type_or_object_field,NotFalse)
when NotFalse /= false ->
asn1ct_name:new(tmpterm),
@@ -789,6 +789,7 @@ gen_enc_choice2(Erules,TopType,[H1|T]) when is_record(H1,'ComponentType') ->
componentrelation)} of
{#'ObjectClassFieldType'{},{componentrelation,_,_}} ->
asn1ct_name:new(tmpBytes),
+ asn1ct_name:new(tmpLen),
asn1ct_name:new(encBytes),
asn1ct_name:new(encLen),
Emit = ["{",{curr,tmpBytes},", _} = "],
@@ -929,7 +930,6 @@ gen_enc_line(Erules,TopType,Cname,
when is_list(Element) ->
case asn1ct_gen:get_constraint(C,componentrelation) of
{componentrelation,_,_} ->
- asn1ct_name:new(tmpBytes),
gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,
["{",{curr,tmpBytes},",_} = "],EncObj);
_ ->
@@ -991,12 +991,8 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj)
{call,ber,encode_open_type,
[{curr,tmpBytes},{asis,Tag}]},nl]);
_ ->
- emit(["{",{next,tmpBytes},",",{curr,tmpLen},
- "} = ",
- {call,ber,encode_open_type,
- [{curr,tmpBytes},{asis,Tag}]},com,nl]),
- emit(IndDeep),
- emit(["{",{next,tmpBytes},", ",{curr,tmpLen},"}"])
+ emit([{call,ber,encode_open_type,
+ [{curr,tmpBytes},{asis,Tag}]}])
end;
Err ->
throw({asn1,{'internal error',Err}})
@@ -1213,22 +1209,18 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC
(Type#type.def)#'ObjectClassFieldType'.fieldname,
[{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)),
asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}];
-gen_dec_call({objectfield,PrimFieldName,PFNList},_,_,Cname,_,BytesVar,Tag,_,_,_,OptOrMandComp) ->
- call(decode_open_type, [BytesVar,{asis,Tag}]),
- [{Cname,{PrimFieldName,PFNList},asn1ct_gen:mk_var(asn1ct_name:curr(term)),
- asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}];
gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand,
OptOrMand,DecObjInf,_) ->
WhatKind = asn1ct_gen:type(InnerType),
gen_dec_call1(WhatKind,InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,
PrimOptOrMand,OptOrMand),
case DecObjInf of
- {Cname,{_,OSet,UniqueFName,ValIndex}} ->
+ {Cname,{_,OSet,_UniqueFName,ValIndex}} ->
Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
ValueMatch = value_match(ValIndex,Term),
{ObjSetMod,ObjSetName} = OSet,
emit([",",nl,"ObjFun = ",{asis,ObjSetMod},":'getdec_",ObjSetName,
- "'(",{asis,UniqueFName},", ",ValueMatch,")"]);
+ "'(",ValueMatch,")"]);
_ ->
ok
end,
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index d279e9697f..8d4afc0a0b 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -43,10 +43,13 @@ gen_encode_set(Erules,TypeName,D) ->
gen_encode_sequence(Erules,TypeName,D) ->
gen_encode_constructed(Erules,TypeName,D).
-gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
+gen_encode_constructed(Erule, Typename, #type{}=D) ->
asn1ct_name:start(),
- asn1ct_name:new(term),
- asn1ct_name:new(bytes),
+ Imm = gen_encode_constructed_imm(Erule, Typename, D),
+ asn1ct_imm:enc_cg(Imm, is_aligned(Erule)),
+ emit([".",nl]).
+
+gen_encode_constructed_imm(Erule, Typename, #type{}=D) ->
{ExtAddGroup,TmpCompList,TableConsInfo} =
case D#type.def of
#'SEQUENCE'{tablecinf=TCI,components=CL,extaddgroup=ExtAddGroup0} ->
@@ -65,74 +68,36 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
[Comp#'ComponentType'{textual_order=undefined}||
Comp<-TmpCompList]
end,
- case Typename of
- ['EXTERNAL'] ->
- emit([{next,val}," = ",
- {call,ext,transform_to_EXTERNAL1990,
- [{curr,val}]},com,nl]),
- asn1ct_name:new(val);
- _ ->
- ok
- end,
- case {Optionals = optionals(to_textual_order(CompList)),CompList,
- is_optimized(Erule)} of
- {[],EmptyCL,_} when EmptyCL == {[],[],[]};EmptyCL == {[],[]};EmptyCL == [] ->
- ok;
- {[],_,_} ->
- emit([{next,val}," = ",{curr,val},",",nl]);
- {_,_,true} ->
- gen_fixoptionals(Optionals),
- FixOpts = param_map(fun(Var) ->
- {var,Var}
- end,asn1ct_name:all(fixopt)),
- emit({"{",{next,val},",Opt} = {",{curr,val},",[",FixOpts,"]},",nl});
- {_,_,false} ->
- asn1ct_func:need({Erule,fixoptionals,3}),
- Fixoptcall = ",Opt} = fixoptionals(",
- emit({"{",{next,val},Fixoptcall,
- {asis,Optionals},",",length(Optionals),
- ",",{curr,val},"),",nl})
- end,
- asn1ct_name:new(val),
+ ExternalImm =
+ case Typename of
+ ['EXTERNAL'] ->
+ Next = asn1ct_gen:mk_var(asn1ct_name:next(val)),
+ Curr = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
+ asn1ct_name:new(val),
+ [{call,ext,transform_to_EXTERNAL1990,[{var,Curr}],{var,Next}}];
+ _ ->
+ []
+ end,
+ Aligned = is_aligned(Erule),
+ Value0 = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
+ Optionals = optionals(to_textual_order(CompList)),
+ ImmOptionals = [asn1ct_imm:per_enc_optional(Value0, Opt, Aligned) ||
+ Opt <- Optionals],
Ext = extensible_enc(CompList),
- case Ext of
- {ext,_,NumExt} when NumExt > 0 ->
- case extgroup_pos_and_length(CompList) of
- {extgrouppos,[]} -> % no extenstionAdditionGroup
- ok;
- {extgrouppos,ExtGroupPosLenList} ->
- ExtGroupFun =
- fun({ExtActualGroupPos,ExtGroupVirtualPos,ExtGroupLen}) ->
- Elements =
- make_elements(ExtGroupVirtualPos+1,
- "Val1",
- lists:seq(1,ExtGroupLen)),
- emit([
- {next,val}," = case [X || X <- [",Elements,
- "],X =/= asn1_NOVALUE] of",nl,
- "[] -> setelement(",
- {asis,ExtActualGroupPos+1},",",
- {curr,val},",",
- "asn1_NOVALUE);",nl,
- "_ -> setelement(",{asis,ExtActualGroupPos+1},",",
- {curr,val},",",
- "{extaddgroup,", Elements,"})",nl,
- "end,",nl]),
- asn1ct_name:new(val)
- end,
- lists:foreach(ExtGroupFun,ExtGroupPosLenList)
- end,
- asn1ct_name:new(tmpval),
- emit(["Extensions = ",
- {call,Erule,fixextensions,[{asis,Ext},{curr,val}]},
- com,nl]);
- _ -> true
- end,
- EncObj =
+ ExtImm = case Ext of
+ {ext,ExtPos,NumExt} when NumExt > 0 ->
+ gen_encode_extaddgroup(CompList),
+ Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
+ asn1ct_imm:per_enc_extensions(Value, ExtPos,
+ NumExt, Aligned);
+ _ ->
+ []
+ end,
+ {EncObj,ObjSetImm} =
case TableConsInfo of
#simpletableattributes{usedclassfield=Used,
uniqueclassfield=Unique} when Used /= Unique ->
- false;
+ {false,[]};
%% ObjectSet, name of the object set in constraints
%%
%%{ObjectSet,AttrN,N,UniqueFieldName} -> %% N is index of attribute that determines constraint
@@ -152,13 +117,10 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
asn1ct_gen:un_hyphen_var(lists:concat(['Obj',AttrN])),
El = make_element(N+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))),
ValueMatch = value_match(ValueIndex, El),
- emit([ObjectEncode," =",nl,
- " ",{asis,Module},":'getenc_",ObjSetName,"'(",
- {asis,UniqueFieldName},", ",nl,
- " ",ValueMatch,"),",nl]),
- {AttrN,ObjectEncode};
+ ObjSetImm0 = [{assign,{var,ObjectEncode},ValueMatch}],
+ {{AttrN,ObjectEncode},ObjSetImm0};
false ->
- false
+ {false,[]}
end;
_ ->
case D#type.tablecinf of
@@ -166,34 +128,52 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
%% when the simpletableattributes was at an outer
%% level and the objfun has been passed through the
%% function call
- {"got objfun through args","ObjFun"};
+ {{"got objfun through args","ObjFun"},[]};
_ ->
- false
+ {false,[]}
end
end,
- emit({"[",nl}),
- MaybeComma1 =
+ ImmSetExt =
case Ext of
- {ext,_Pos,NumExt2} when NumExt2 > 0 ->
- call(Erule, setext, ["Extensions =/= []"]),
- ", ";
- {ext,_Pos,_} ->
- call(Erule, setext, ["false"]),
- ", ";
- _ ->
- ""
- end,
- MaybeComma2 =
- case optionals(CompList) of
- [] -> MaybeComma1;
- _ ->
- emit(MaybeComma1),
- emit("Opt"),
- {",",nl}
+ {ext,_Pos,NumExt2} when NumExt2 > 0 ->
+ asn1ct_imm:per_enc_extension_bit('Extensions', Aligned);
+ {ext,_Pos,_} ->
+ asn1ct_imm:per_enc_extension_bit([], Aligned);
+ _ ->
+ []
end,
- gen_enc_components_call(Erule,Typename,CompList,MaybeComma2,EncObj,Ext),
- emit({"].",nl}).
+ ImmBody = gen_enc_components_call(Erule, Typename, CompList, EncObj, Ext),
+ ExternalImm ++ ExtImm ++ ObjSetImm ++
+ asn1ct_imm:enc_append([ImmSetExt] ++ ImmOptionals ++ ImmBody).
+
+gen_encode_extaddgroup(CompList) ->
+ case extgroup_pos_and_length(CompList) of
+ {extgrouppos,[]} ->
+ ok;
+ {extgrouppos,ExtGroupPosLenList} ->
+ _ = [do_gen_encode_extaddgroup(G) || G <- ExtGroupPosLenList],
+ ok
+ end.
+do_gen_encode_extaddgroup({ActualGroupPos,GroupVirtualPos,GroupLen}) ->
+ Val = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
+ Elements = make_elements(GroupVirtualPos+1,
+ Val,
+ lists:seq(1, GroupLen)),
+ Expr = any_non_value(GroupVirtualPos+1, Val, GroupLen, ""),
+ emit([{next,val}," = case ",Expr," of",nl,
+ "false -> setelement(",{asis,ActualGroupPos+1},", ",
+ {curr,val},", asn1_NOVALUE);",nl,
+ "true -> setelement(",{asis,ActualGroupPos+1},", ",
+ {curr,val},", {extaddgroup,", Elements,"})",nl,
+ "end,",nl]),
+ asn1ct_name:new(val).
+
+any_non_value(_, _, 0, _) ->
+ [];
+any_non_value(Pos, Val, N, Sep) ->
+ Sep ++ [make_element(Pos, Val)," =/= asn1_NOVALUE"] ++
+ any_non_value(Pos+1, Val, N-1, [" orelse",nl]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% generate decode function for SEQUENCE and SET
@@ -328,28 +308,29 @@ gen_dec_constructed_imm(Erule, Typename, #type{}=D) ->
EmitComp = gen_dec_components_call(Erule, Typename, CompList,
DecObjInf, Ext, length(Optionals)),
EmitRest = fun({AccTerm,AccBytes}) ->
- gen_dec_constructed_imm_2(Typename, CompList,
+ gen_dec_constructed_imm_2(Erule, Typename,
+ CompList,
ObjSetInfo,
AccTerm, AccBytes)
end,
[EmitExt,EmitOpt|EmitComp++[{safe,EmitRest}]].
-gen_dec_constructed_imm_2(Typename, CompList,
+gen_dec_constructed_imm_2(Erule, Typename, CompList,
ObjSetInfo, AccTerm, AccBytes) ->
- {_,UniqueFName,ValueIndex} = ObjSetInfo,
+ {_,_UniqueFName,ValueIndex} = ObjSetInfo,
case {AccTerm,AccBytes} of
{[],[]} ->
ok;
{_,[]} ->
ok;
{[{ObjSet,LeadingAttr,Term}],ListOfOpenTypes} ->
- DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])),
- ValueMatch = value_match(ValueIndex,Term),
- {ObjSetMod,ObjSetName} = ObjSet,
- emit([DecObj," =",nl,
- " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,"),",nl]),
- gen_dec_listofopentypes(DecObj,ListOfOpenTypes,false)
+ ValueMatch = value_match(ValueIndex, Term),
+ _ = [begin
+ gen_dec_open_type(Erule, ValueMatch, ObjSet,
+ LeadingAttr, T),
+ emit([com,nl])
+ end || T <- ListOfOpenTypes],
+ ok
end,
%% we don't return named lists any more Cnames = mkcnamelist(CompList),
demit({"Result = "}), %dbg
@@ -423,67 +404,143 @@ to_textual_order(Cs) when is_list(Cs) ->
to_textual_order(Cs) ->
Cs.
-gen_dec_listofopentypes(_,[],_) ->
- emit(nl);
-gen_dec_listofopentypes(DecObj,[{_Cname,{FirstPFN,PFNList},Term,TmpTerm,Prop}|Rest],_Update) ->
-
- asn1ct_name:new(tmpterm),
- asn1ct_name:new(reason),
-
- emit([Term," = ",nl]),
+gen_dec_open_type(Erule, Val, {Xmod,Xtype}, LeadingAttr,
+ {_,{Name,RestFieldNames},Term,TmpTerm,Prop}) ->
+ #typedef{typespec=ObjSet0} = asn1_db:dbget(Xmod, Xtype),
+ #'ObjectSet'{class=Class,set=ObjSet1} = ObjSet0,
+ #'Externaltypereference'{module=ClMod,type=ClType} = Class,
+ #classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType),
+ #objectclass{fields=ClassFields} = ClassDef,
+ Extensible = lists:member('EXTENSIONMARK', ObjSet1),
+ ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} ||
+ {_,Key,Code} <- ObjSet1],
+ ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]),
+ Key = erlang:md5(term_to_binary({decode,ObjSet,RestFieldNames,
+ Prop,Extensible})),
+ Typename = [Name,ClType],
+ Gen = fun(_Fd, N) ->
+ dec_objset_optional(N, Prop),
+ dec_objset(Erule, N, ObjSet, RestFieldNames, Typename),
+ dec_objset_default(N, Name, LeadingAttr, Extensible)
+ end,
+ Prefix = lists:concat(["dec_os_",Name]),
+ F = asn1ct_func:call_gen(Prefix, Key, Gen),
+ emit([Term," = ",{asis,F},"(",TmpTerm,", ",Val,")"]).
+
+dec_objset_optional(N, {'DEFAULT',Val}) ->
+ dec_objset_optional_1(N, Val),
+ dec_objset_optional_1(N, asn1_DEFAULT);
+dec_objset_optional(N, 'OPTIONAL') ->
+ dec_objset_optional_1(N, asn1_NOVALUE);
+dec_objset_optional(_N, mandatory) -> ok.
+
+dec_objset_optional_1(N, Val) ->
+ emit([{asis,N},"(",{asis,Val},", _Id) ->",nl,
+ {asis,Val},";",nl]).
+
+dec_objset(_Erule, _N, [], _, _) ->
+ ok;
+dec_objset(Erule, N, [Obj|Objs], RestFields, Cl) ->
+ dec_objset_1(Erule, N, Obj, RestFields, Cl),
+ emit([";",nl]),
+ dec_objset(Erule, N, Objs, RestFields, Cl).
+
+dec_objset_default(N, C, LeadingAttr, false) ->
+ emit([{asis,N},"(Bytes, Id) ->",nl,
+ "exit({'Type not compatible with table constraint',"
+ "{{component,",{asis,C},"},"
+ "{value,Bytes},"
+ "{unique_name_and_value,",{asis,LeadingAttr},",Id}}}).",nl,nl]);
+dec_objset_default(N, _, _, true) ->
+ emit([{asis,N},"(Bytes, Id) ->",nl,
+ "Bytes.",nl,nl]).
+
+dec_objset_1(Erule, N, {Id,Obj}, RestFields, Typename) ->
+ emit([{asis,N},"(Bytes, ",{asis,Id},") ->",nl]),
+ dec_objset_2(Erule, Obj, RestFields, Typename).
+
+dec_objset_2(Erule, Obj, RestFields0, Typename) ->
+ case Obj of
+ #typedef{name={primitive,bif},typespec=Type} ->
+ Imm = asn1ct_gen_per:gen_dec_imm(Erule, Type),
+ {Term,_} = asn1ct_imm:dec_slim_cg(Imm, 'Bytes'),
+ emit([com,nl,Term]);
+ #typedef{name={constructed,bif},typespec=Def} ->
+ InnerType = asn1ct_gen:get_inner(Def#type.def),
+ case InnerType of
+ 'CHOICE' ->
+ asn1ct_name:start(),
+ asn1ct_name:new(bytes),
+ {'CHOICE',CompList} = Def#type.def,
+ Ext = extensible_enc(CompList),
+ emit(["{Result,_} = begin",nl]),
+ gen_dec_choice(Erule, Typename, CompList, Ext),
+ emit([nl,
+ "end",com,nl,
+ "Result"]);
+ 'SET' ->
+ Imm0 = gen_dec_constructed_imm(Erule, Typename, Def),
+ Imm = opt_imm(Imm0),
+ asn1ct_name:start(),
+ emit(["{Result,_} = begin",nl]),
+ emit_gen_dec_imm(Imm),
+ emit([nl,
+ "end",com,nl,
+ "Result"]);
+ 'SET OF' ->
+ asn1ct_name:start(),
+ do_gen_decode_sof(Erule, Typename, 'SET OF',
+ Def, false);
+ 'SEQUENCE' ->
+ Imm0 = gen_dec_constructed_imm(Erule, Typename, Def),
+ Imm = opt_imm(Imm0),
+ asn1ct_name:start(),
+ emit(["{Result,_} = begin",nl]),
+ emit_gen_dec_imm(Imm),
+ emit([nl,
+ "end",com,nl,
+ "Result"]);
+ 'SEQUENCE OF' ->
+ asn1ct_name:start(),
+ do_gen_decode_sof(Erule, Typename, 'SEQUENCE OF',
+ Def, false)
+ end;
+ #typedef{name=Type} ->
+ emit(["{Result,_} = ",{asis,enc_func("dec_", Type)},"(Bytes),",nl,
+ "Result"]);
+ #'Externaltypereference'{module=Mod,type=Type} ->
+ emit("{Term,_} = "),
+ Func = enc_func("dec_", Type),
+ case get(currmod) of
+ Mod ->
+ emit([{asis,Func},"(Bytes)"]);
+ _ ->
+ emit([{asis,Mod},":",{asis,Func},"(Bytes)"])
+ end,
+ emit([com,nl,
+ "Term"]);
+ #'Externalvaluereference'{module=Mod,value=Value} ->
+ case asn1_db:dbget(Mod, Value) of
+ #typedef{typespec=#'Object'{def=Def}} ->
+ {object,_,Fields} = Def,
+ [NextField|RestFields] = RestFields0,
+ {NextField,Typedef} = lists:keyfind(NextField, 1, Fields),
+ dec_objset_2(Erule, Typedef, RestFields, Typename)
+ end
+ end.
- N = case Prop of
- mandatory -> 0;
- 'OPTIONAL' ->
- emit_opt_or_mand_check(asn1_NOVALUE,TmpTerm),
- 6;
- {'DEFAULT',Val} ->
- emit_opt_or_mand_check(Val,TmpTerm),
- 6
- end,
+gen_encode_choice(Erule, TopType, D) ->
+ asn1ct_name:start(),
+ Imm = gen_encode_choice_imm(Erule, TopType, D),
+ asn1ct_imm:enc_cg(Imm, is_aligned(Erule)),
+ emit([".",nl]).
- emit([indent(N+3),"case (catch ",DecObj,"(",
- {asis,FirstPFN},", ",TmpTerm,", telltype,",{asis,PFNList},")) of",nl]),
- emit([indent(N+6),"{'EXIT', ",{curr,reason},"} ->",nl]),
- emit([indent(N+9),"exit({'Type not compatible with table constraint',",
- {curr,reason},"});",nl]),
- emit([indent(N+6),"{",{curr,tmpterm},",_} ->",nl]),
- emit([indent(N+9),{curr,tmpterm},nl]),
-
- case Prop of
- mandatory ->
- emit([indent(N+3),"end,",nl]);
- _ ->
- emit([indent(N+3),"end",nl,
- indent(3),"end,",nl])
- end,
- gen_dec_listofopentypes(DecObj,Rest,true).
-
-
-emit_opt_or_mand_check(Val,Term) ->
- emit([indent(3),"case ",Term," of",nl,
- indent(6),{asis,Val}," ->",{asis,Val},";",nl,
- indent(6),"_ ->",nl]).
-
-%% ENCODE GENERATOR FOR THE CHOICE TYPE *******
-%% assume Val = {Alternative,AltType}
-%% generate
-%%[
-%% ?RT_PER:set_choice(element(1,Val),Altnum,Altlist,ext),
-%%case element(1,Val) of
-%% alt1 ->
-%% encode_alt1(element(2,Val));
-%% alt2 ->
-%% encode_alt2(element(2,Val))
-%%end
-%%].
-
-gen_encode_choice(Erule,Typename,D) when is_record(D,type) ->
- {'CHOICE',CompList} = D#type.def,
- emit({"[",nl}),
+gen_encode_choice_imm(Erule, TopType, #type{def={'CHOICE',CompList}}) ->
Ext = extensible_enc(CompList),
- gen_enc_choice(Erule,Typename,CompList,Ext),
- emit({nl,"].",nl}).
+ Aligned = is_aligned(Erule),
+ Cs = gen_enc_choice(Erule, TopType, CompList, Ext),
+ [{assign,{expr,"{ChoiceTag,ChoiceVal}"},"Val"}|
+ asn1ct_imm:per_enc_choice('ChoiceTag', Cs, Aligned)].
gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
@@ -496,72 +553,48 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Encode generator for SEQUENCE OF type
-
-gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) ->
+gen_encode_sof(Erule, Typename, SeqOrSetOf, D) ->
asn1ct_name:start(),
- {_SeqOrSetOf,ComponentType} = D#type.def,
- emit({"[",nl}),
- SizeConstraint = asn1ct_imm:effective_constraint(bitstring,
- D#type.constraint),
- ObjFun =
- case D#type.tablecinf of
- [{objfun,_}|_R] ->
- ", ObjFun";
- _->
- ""
- end,
- gen_encode_length(Erule, SizeConstraint),
- emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename),
- "_components'(Val",ObjFun,", [])"}),
- emit({nl,"].",nl}),
- gen_encode_sof_components(Erule, Typename, SeqOrSetOf, ComponentType).
-
-
-%% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number
-gen_encode_length(per, {Lb,Ub}) when Ub =< 65535, Lb >= 0 ->
- Range = Ub - Lb + 1,
- V2 = ["(length(Val) - ",Lb,")"],
- Encode = if
- Range == 1 ->
- "[]";
- Range == 2 ->
- {"[",V2,"]"};
- Range =< 4 ->
- {"[10,2,",V2,"]"};
- Range =< 8 ->
- {"[10,3,",V2,"]"};
- Range =< 16 ->
- {"[10,4,",V2,"]"};
- Range =< 32 ->
- {"[10,5,",V2,"]"};
- Range =< 64 ->
- {"[10,6,",V2,"]"};
- Range =< 128 ->
- {"[10,7,",V2,"]"};
- Range =< 255 ->
- {"[10,8,",V2,"]"};
- Range =< 256 ->
- {"[20,1,",V2,"]"};
- Range =< 65536 ->
- {"[20,2,<<",V2,":16>>]"};
- true ->
- {call,per,encode_length,
- [{asis,{Lb,Ub}},"length(Val)"]}
- end,
- emit({nl,Encode,",",nl});
-gen_encode_length(Erules, SizeConstraint) ->
- emit([nl,indent(3),
- case SizeConstraint of
- no ->
- {call,Erules,encode_length,["length(Val)"]};
- _ ->
- {call,Erules,encode_length,
- [{asis,SizeConstraint},"length(Val)"]}
- end,
- com,nl]).
+ Imm = gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, D),
+ asn1ct_imm:enc_cg(Imm, is_aligned(Erule)),
+ emit([".",nl,nl]).
-gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) ->
+gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) ->
+ {_SeqOrSetOf,ComponentType} = D#type.def,
+ Aligned = is_aligned(Erule),
+ Constructed_Suffix =
+ asn1ct_gen:constructed_suffix(SeqOrSetOf,
+ ComponentType#type.def),
+ Conttype = asn1ct_gen:get_inner(ComponentType#type.def),
+ Currmod = get(currmod),
+ Imm0 = case asn1ct_gen:type(Conttype) of
+ {primitive,bif} ->
+ asn1ct_gen_per:gen_encode_prim_imm('Comp', ComponentType, Aligned);
+ {constructed,bif} ->
+ TypeName = [Constructed_Suffix|Typename],
+ Enc = enc_func(asn1ct_gen:list2name(TypeName)),
+ ObjArg = case D#type.tablecinf of
+ [{objfun,_}|_] -> [{var,"ObjFun"}];
+ _ -> []
+ end,
+ [{apply,Enc,[{var,"Comp"}|ObjArg]}];
+ #'Externaltypereference'{module=Currmod,type=Ename} ->
+ [{apply,enc_func(Ename),[{var,"Comp"}]}];
+ #'Externaltypereference'{module=EMod,type=Ename} ->
+ [{apply,{EMod,enc_func(Ename)},[{var,"Comp"}]}];
+ 'ASN1_OPEN_TYPE' ->
+ asn1ct_gen_per:gen_encode_prim_imm('Comp',
+ #type{def='ASN1_OPEN_TYPE'},
+ Aligned)
+ end,
+ asn1ct_imm:per_enc_sof('Val', D#type.constraint, 'Comp', Imm0, Aligned).
+
+gen_decode_sof(Erules, Typename, SeqOrSetOf, #type{}=D) ->
asn1ct_name:start(),
+ do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, true),
+ emit([".",nl,nl]).
+
+do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, NeedRest) ->
{_SeqOrSetOf,ComponentType} = D#type.def,
SizeConstraint = asn1ct_imm:effective_constraint(bitstring,
D#type.constraint),
@@ -573,10 +606,16 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) ->
""
end,
{Num,Buf} = gen_decode_length(SizeConstraint, Erules),
+ Key = erlang:md5(term_to_binary({Typename,SeqOrSetOf,
+ ComponentType,NeedRest})),
+ Gen = fun(_Fd, Name) ->
+ gen_decode_sof_components(Erules, Name,
+ Typename, SeqOrSetOf,
+ ComponentType, NeedRest)
+ end,
+ F = asn1ct_func:call_gen("dec_components", Key, Gen),
emit([",",nl,
- "'dec_",asn1ct_gen:list2name(Typename),
- "_components'(",Num,", ",Buf,ObjFun,", []).",nl,nl]),
- gen_decode_sof_components(Erules, Typename, SeqOrSetOf, ComponentType).
+ {asis,F},"(",Num,", ",Buf,ObjFun,", [])"]).
is_aligned(per) -> true;
is_aligned(uper) -> false.
@@ -586,7 +625,7 @@ gen_decode_length(Constraint, Erule) ->
Imm = asn1ct_imm:per_dec_length(Constraint, true, is_aligned(Erule)),
asn1ct_imm:dec_slim_cg(Imm, "Bytes").
-gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
+gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont, NeedRest) ->
{ObjFun,ObjFun_Var} =
case Cont#type.tablecinf of
[{objfun,_}|_R] ->
@@ -594,76 +633,38 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
_ ->
{"",""}
end,
- emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'([]",
- ObjFun_Var,", Acc) -> lists:reverse(Acc);",nl,nl}),
- emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'([H|T]",
- ObjFun,", Acc) ->",nl}),
- emit({"'enc_",asn1ct_gen:list2name(Typename),"_components'(T"}),
- emit({ObjFun,", ["}),
- %% the component encoder
- Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,
- Cont#type.def),
-
- Conttype = asn1ct_gen:get_inner(Cont#type.def),
- Currmod = get(currmod),
- case asn1ct_gen:type(Conttype) of
- {primitive,bif} ->
- asn1ct_gen_per:gen_encode_prim(Erule, Cont, "H");
- {constructed,bif} ->
- NewTypename = [Constructed_Suffix|Typename],
- emit({"'enc_",asn1ct_gen:list2name(NewTypename),"'(H",
- ObjFun,")",nl,nl});
- #'Externaltypereference'{module=Currmod,type=Ename} ->
- emit({"'enc_",Ename,"'(H)",nl,nl});
- #'Externaltypereference'{module=EMod,type=EType} ->
- emit({"'",EMod,"':'enc_",EType,"'(H)",nl,nl});
- 'ASN1_OPEN_TYPE' ->
- asn1ct_gen_per:gen_encode_prim(Erule,
- #type{def='ASN1_OPEN_TYPE'},
- "H");
- _ ->
- emit({"'enc_",Conttype,"'(H)",nl,nl})
+ case NeedRest of
+ false ->
+ emit([{asis,Name},"(0, _Bytes",ObjFun_Var,", Acc) ->",nl,
+ "lists:reverse(Acc);",nl]);
+ true ->
+ emit([{asis,Name},"(0, Bytes",ObjFun_Var,", Acc) ->",nl,
+ "{lists:reverse(Acc),Bytes};",nl])
end,
- emit({" | Acc]).",nl}).
-
-gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) ->
- {ObjFun,ObjFun_Var} =
- case Cont#type.tablecinf of
- [{objfun,_}|_R] ->
- {", ObjFun",", _"};
- _ ->
- {"",""}
- end,
- emit({"'dec_",asn1ct_gen:list2name(Typename),
- "_components'(0, Bytes",ObjFun_Var,", Acc) ->",nl,
- indent(3),"{lists:reverse(Acc), Bytes};",nl}),
- emit({"'dec_",asn1ct_gen:list2name(Typename),
- "_components'(Num, Bytes",ObjFun,", Acc) ->",nl}),
- emit({indent(3),"{Term,Remain} = "}),
+ emit([{asis,Name},"(Num, Bytes",ObjFun,", Acc) ->",nl,
+ "{Term,Remain} = "]),
Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,
Cont#type.def),
Conttype = asn1ct_gen:get_inner(Cont#type.def),
- Ctgenmod = asn1ct_gen:ct_gen_module(Erule),
case asn1ct_gen:type(Conttype) of
{primitive,bif} ->
- Ctgenmod:gen_dec_prim(Erule,Cont,"Bytes"),
+ asn1ct_gen_per:gen_dec_prim(Erule, Cont, "Bytes"),
emit({com,nl});
{constructed,bif} ->
NewTypename = [Constructed_Suffix|Typename],
emit({"'dec_",asn1ct_gen:list2name(NewTypename),
- "'(Bytes, telltype",ObjFun,"),",nl});
+ "'(Bytes",ObjFun,"),",nl});
#'Externaltypereference'{}=Etype ->
asn1ct_gen_per:gen_dec_external(Etype, "Bytes"),
emit([com,nl]);
'ASN1_OPEN_TYPE' ->
- Ctgenmod:gen_dec_prim(Erule,#type{def='ASN1_OPEN_TYPE'},
- "Bytes"),
+ asn1ct_gen_per:gen_dec_prim(Erule, #type{def='ASN1_OPEN_TYPE'},
+ "Bytes"),
emit({com,nl});
_ ->
- emit({"'dec_",Conttype,"'(Bytes,telltype),",nl})
+ emit({"'dec_",Conttype,"'(Bytes),",nl})
end,
- emit({indent(3),"'dec_",asn1ct_gen:list2name(Typename),
- "_components'(Num-1, Remain",ObjFun,", [Term|Acc]).",nl}).
+ emit([{asis,Name},"(Num-1, Remain",ObjFun,", [Term|Acc]).",nl]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -754,27 +755,6 @@ gen_dec_optionals(Optionals) ->
end,
{imm,Imm0,E}.
-gen_fixoptionals([{Pos,Def}|R]) ->
- asn1ct_name:new(fixopt),
- emit({{curr,fixopt}," = case element(",{asis,Pos},",",{curr,val},") of",nl,
- "asn1_DEFAULT -> 0;",nl,
- {asis,Def}," -> 0;",nl,
- "_ -> 1",nl,
- "end,",nl}),
- gen_fixoptionals(R);
-gen_fixoptionals([Pos|R]) ->
- gen_fixoptionals([{Pos,asn1_NOVALUE}|R]);
-gen_fixoptionals([]) ->
- ok.
-
-
-param_map(Fun, [H]) ->
- [Fun(H)];
-param_map(Fun, [H|T]) ->
- [Fun(H),","|param_map(Fun,T)].
-
-
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Produce a list with positions (in the Value record) where
%% there are optional components, start with 2 because first element
@@ -788,15 +768,13 @@ optionals({L1,Ext,L2}) ->
optionals({L,_Ext}) -> optionals(L,[],2);
optionals(L) -> optionals(L,[],2).
-optionals([{'EXTENSIONMARK',_,_}|Rest],Acc,Pos) ->
- optionals(Rest,Acc,Pos); % optionals in extension are currently not handled
-optionals([#'ComponentType'{prop='OPTIONAL'}|Rest],Acc,Pos) ->
- optionals(Rest,[Pos|Acc],Pos+1);
-optionals([#'ComponentType'{prop={'DEFAULT',Val}}|Rest],Acc,Pos) ->
- optionals(Rest,[{Pos,Val}|Acc],Pos+1);
-optionals([#'ComponentType'{}|Rest],Acc,Pos) ->
- optionals(Rest,Acc,Pos+1);
-optionals([],Acc,_) ->
+optionals([#'ComponentType'{prop='OPTIONAL'}|Rest], Acc, Pos) ->
+ optionals(Rest, [Pos|Acc], Pos+1);
+optionals([#'ComponentType'{prop={'DEFAULT',Val}}|Rest], Acc, Pos) ->
+ optionals(Rest, [{Pos,Val}|Acc], Pos+1);
+optionals([#'ComponentType'{}|Rest], Acc, Pos) ->
+ optionals(Rest, Acc, Pos+1);
+optionals([], Acc, _) ->
lists:reverse(Acc).
%%%%%%%%%%%%%%%%%%%%%%
@@ -858,33 +836,32 @@ add_textual_order1(Cs,NumIn) ->
end,
NumIn,Cs).
-gen_enc_components_call(Erule,TopType,{Root,ExtList},MaybeComma,DynamicEnc,Ext) ->
- gen_enc_components_call(Erule,TopType,{Root,ExtList,[]},MaybeComma,DynamicEnc,Ext);
-gen_enc_components_call(Erule,TopType,CL={Root,ExtList,Root2},MaybeComma,DynamicEnc,Ext) ->
+gen_enc_components_call(Erule,TopType,{Root,ExtList}, DynamicEnc,Ext) ->
+ gen_enc_components_call(Erule,TopType,{Root,ExtList,[]}, DynamicEnc,Ext);
+gen_enc_components_call(Erule,TopType,CL={Root,ExtList,Root2}, DynamicEnc,Ext) ->
%% The type has extensionmarker
- Rpos = gen_enc_components_call1(Erule,TopType,Root++Root2,1,MaybeComma,DynamicEnc,noext),
- case Ext of
- {ext,_,ExtNum} when ExtNum > 0 ->
- emit([nl,
- ",Extensions",nl]);
-
- _ -> true
- end,
+ {Imm0,Rpos} = gen_enc_components_call1(Erule,TopType,Root++Root2,1, DynamicEnc,noext,[]),
+ ExtImm = case Ext of
+ {ext,_,ExtNum} when ExtNum > 0 ->
+ [{var,"Extensions"}];
+ _ ->
+ []
+ end,
%handle extensions
{extgrouppos,ExtGroupPosLen} = extgroup_pos_and_length(CL),
NewExtList = wrap_extensionAdditionGroups(ExtList,ExtGroupPosLen),
- gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,MaybeComma,DynamicEnc,Ext);
-gen_enc_components_call(Erule,TopType, CompList, MaybeComma, DynamicEnc, Ext) ->
+ {Imm1,_} = gen_enc_components_call1(Erule,TopType,NewExtList,Rpos,DynamicEnc,Ext,[]),
+ Imm0 ++ [ExtImm|Imm1];
+gen_enc_components_call(Erule,TopType, CompList, DynamicEnc, Ext) ->
%% The type has no extensionmarker
- gen_enc_components_call1(Erule,TopType,CompList,1,MaybeComma,DynamicEnc,Ext).
+ {Imm,_} = gen_enc_components_call1(Erule,TopType,CompList,1,DynamicEnc,Ext,[]),
+ Imm.
gen_enc_components_call1(Erule,TopType,
[C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop}|Rest],
Tpos,
- MaybeComma, DynamicEnc, Ext) ->
+ DynamicEnc, Ext, Acc) ->
- put(component_type,{true,C}),
- %% information necessary in asn1ct_gen_per_rt2ct:gen_encode_prim
TermNo =
case C#'ComponentType'.textual_order of
undefined ->
@@ -892,90 +869,48 @@ gen_enc_components_call1(Erule,TopType,
CanonicalNum ->
CanonicalNum
end,
- emit(MaybeComma),
- case Prop of
- 'OPTIONAL' ->
- gen_enc_component_optional(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext);
- {'DEFAULT',DefVal} ->
- gen_enc_component_default(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext,DefVal);
+ Element0 = make_element(TermNo+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))),
+ {Imm0,Element} = asn1ct_imm:enc_bind_var(Element0),
+ Imm1 = gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext),
+ Category = case {Prop,Ext} of
+ {'OPTIONAL',_} ->
+ optional;
+ {{'DEFAULT',DefVal},_} ->
+ {default,DefVal};
+ {_,{ext,ExtPos,_}} when Tpos >= ExtPos ->
+ optional;
+ {_,_} ->
+ mandatory
+ end,
+ Imm2 = case Category of
+ mandatory ->
+ Imm1;
+ optional ->
+ asn1ct_imm:enc_absent(Element, [asn1_NOVALUE], Imm1);
+ {default,Def} ->
+ asn1ct_imm:enc_absent(Element, [asn1_DEFAULT,Def], Imm1)
+ end,
+ Imm = case Imm2 of
+ [] -> [];
+ _ -> Imm0 ++ Imm2
+ end,
+ gen_enc_components_call1(Erule, TopType, Rest, Tpos+1, DynamicEnc, Ext, [Imm|Acc]);
+gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_, Acc) ->
+ ImmList = lists:reverse(Acc),
+ {ImmList,Pos}.
+
+gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext) ->
+ Imm0 = gen_enc_line_imm_1(Erule, TopType, Cname, Type,
+ Element, DynamicEnc),
+ Aligned = is_aligned(Erule),
+ case Ext of
+ {ext,_Ep2,_} ->
+ asn1ct_imm:per_enc_open_type(Imm0, Aligned);
_ ->
- case Ext of
- {ext,ExtPos,_} when Tpos >= ExtPos ->
- gen_enc_component_optional(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext);
- _ ->
- gen_enc_component_mandatory(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext)
- end
- end,
-
- erase(component_type),
+ Imm0
+ end.
- case Rest of
- [] ->
- Tpos+1;
- _ ->
- emit({com,nl}),
- gen_enc_components_call1(Erule,TopType,Rest,Tpos+1,"",DynamicEnc,Ext)
- end;
-gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_,_) ->
- Pos.
-
-gen_enc_component_default(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext,DefaultVal) ->
- Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
- emit({"case ",Element," of",nl}),
-% emit({"asn1_DEFAULT -> [];",nl}),
- emit({"DFLT when DFLT == asn1_DEFAULT; DFLT == ",{asis,DefaultVal}," -> [];",nl}),
-
- asn1ct_name:new(tmpval),
- emit({{curr,tmpval}," ->",nl}),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- emit({nl,"%% attribute number ",Pos," with type ",
- InnerType,nl}),
- NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)),
- gen_enc_line(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext),
- emit({nl,"end"}).
-
-gen_enc_component_optional(Erule,TopType,Cname,
- Type=#type{def=#'SEQUENCE'{
- extaddgroup=Number,
- components=_ExtGroupCompList}},
- Pos,DynamicEnc,Ext) when is_integer(Number) ->
-
- Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
- emit({"case ",Element," of",nl}),
-
- emit({"asn1_NOVALUE -> [];",nl}),
- asn1ct_name:new(tmpval),
- emit({{curr,tmpval}," ->",nl}),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- emit({nl,"%% attribute number ",Pos," with type ",
- InnerType,nl}),
- NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)),
- gen_enc_line(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext),
- emit({nl,"end"});
-gen_enc_component_optional(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) ->
- Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
- emit({"case ",Element," of",nl}),
-
- emit({"asn1_NOVALUE -> [];",nl}),
- asn1ct_name:new(tmpval),
- emit({{curr,tmpval}," ->",nl}),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- emit({nl,"%% attribute number ",Pos," with type ",
- InnerType,nl}),
- NextElement = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)),
- gen_enc_line(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext),
- emit({nl,"end"}).
-
-gen_enc_component_mandatory(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) ->
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- emit({nl,"%% attribute number ",Pos," with type ",
- InnerType,nl}),
- gen_enc_line(Erule,TopType,Cname,Type,[],Pos,DynamicEnc,Ext).
-
-gen_enc_line(Erule,TopType, Cname, Type, [], Pos,DynamicEnc,Ext) ->
- Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))),
- gen_enc_line(Erule,TopType,Cname,Type,Element, Pos,DynamicEnc,Ext);
-gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
+gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc) ->
Atype =
case Type of
#type{def=#'ObjectClassFieldType'{type=InnerType}} ->
@@ -983,81 +918,157 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) ->
_ ->
asn1ct_gen:get_inner(Type#type.def)
end,
-
- case Ext of
- {ext,_Ep1,_} ->
- asn1ct_func:need({Erule,encode_open_type,1}),
- asn1ct_func:need({Erule,complete,1}),
- emit(["encode_open_type(complete("]);
- _ -> true
- end,
-
+ Aligned = is_aligned(Erule),
case Atype of
{typefield,_} ->
- case DynamicEnc of
- {_LeadingAttrName,Fun} ->
- case (Type#type.def)#'ObjectClassFieldType'.fieldname of
- {Name,RestFieldNames} when is_atom(Name) ->
- asn1ct_func:need({Erule,complete,1}),
- asn1ct_func:need({Erule,encode_open_type,1}),
- emit({"encode_open_type(complete(",nl}),
- emit({" ",Fun,"(",{asis,Name},", ",
- Element,", ",{asis,RestFieldNames},")))"});
- Other ->
- throw({asn1,{'internal error',Other}})
- end
- end;
- {objectfield,PrimFieldName1,PFNList} ->
- case DynamicEnc of
- {_LeadingAttrName,Fun} ->
- asn1ct_func:need({Erule,complete,1}),
- asn1ct_func:need({Erule,encode_open_type,1}),
- emit({"encode_open_type("
- "complete(",nl}),
- emit({" ",Fun,"(",{asis,PrimFieldName1},
- ", ",Element,", ",{asis,PFNList},")))"})
+ {_LeadingAttrName,Fun} = DynamicEnc,
+ case (Type#type.def)#'ObjectClassFieldType'.fieldname of
+ {Name,RestFieldNames} when is_atom(Name) ->
+ Imm = enc_var_type_call(Erule, Name, RestFieldNames,
+ Type, Fun, Element),
+ asn1ct_imm:per_enc_open_type(Imm, Aligned)
end;
_ ->
CurrMod = get(currmod),
case asn1ct_gen:type(Atype) of
- #'Externaltypereference'{module=Mod,type=EType} when
- (CurrMod==Mod) ->
- emit({"'enc_",EType,"'(",Element,")"});
+ #'Externaltypereference'{module=CurrMod,type=EType} ->
+ [{apply,enc_func(EType),[{expr,Element}]}];
#'Externaltypereference'{module=Mod,type=EType} ->
- emit({"'",Mod,"':'enc_",
- EType,"'(",Element,")"});
+ [{apply,{Mod,enc_func(EType)},[{expr,Element}]}];
{primitive,bif} ->
- asn1ct_gen_per:gen_encode_prim(Erule, Type, Element);
+ asn1ct_gen_per:gen_encode_prim_imm(Element, Type, Aligned);
'ASN1_OPEN_TYPE' ->
case Type#type.def of
#'ObjectClassFieldType'{type=OpenType} ->
- asn1ct_gen_per:gen_encode_prim(Erule,
- #type{def=OpenType},
- Element);
+ asn1ct_gen_per:gen_encode_prim_imm(Element,
+ #type{def=OpenType},
+ Aligned);
_ ->
- asn1ct_gen_per:gen_encode_prim(Erule, Type,
- Element)
+ asn1ct_gen_per:gen_encode_prim_imm(Element,
+ Type,
+ Aligned)
end;
{constructed,bif} ->
NewTypename = [Cname|TopType],
+ Enc = enc_func(asn1ct_gen:list2name(NewTypename)),
case {Type#type.tablecinf,DynamicEnc} of
{[{objfun,_}|_R],{_,EncFun}} ->
- emit({"'enc_",
- asn1ct_gen:list2name(NewTypename),
- "'(",Element,", ",EncFun,")"});
+ [{apply,Enc,[{expr,Element},{var,EncFun}]}];
_ ->
- emit({"'enc_",
- asn1ct_gen:list2name(NewTypename),
- "'(",Element,")"})
+ [{apply,Enc,[{expr,Element}]}]
end
end
- end,
- case Ext of
- {ext,_Ep2,_} ->
- emit("))");
- _ -> true
end.
+enc_func(Type) ->
+ enc_func("enc_", Type).
+
+enc_func(Prefix, Name) ->
+ list_to_atom(lists:concat([Prefix,Name])).
+
+enc_var_type_call(Erule, Name, RestFieldNames,
+ #type{tablecinf=TCI}, Fun, Val) ->
+ [{objfun,#'Externaltypereference'{module=Xmod,type=Xtype}}] = TCI,
+ #typedef{typespec=ObjSet0} = asn1_db:dbget(Xmod, Xtype),
+ #'ObjectSet'{class=Class,set=ObjSet1} = ObjSet0,
+ #'Externaltypereference'{module=ClMod,type=ClType} = Class,
+ #classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType),
+ #objectclass{fields=ClassFields} = ClassDef,
+ Extensible = lists:member('EXTENSIONMARK', ObjSet1),
+ ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} ||
+ {_,Key,Code} <- ObjSet1],
+ ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]),
+ Key = erlang:md5(term_to_binary({encode,ObjSet,RestFieldNames,Extensible})),
+ Gen = fun(_Fd, N) ->
+ enc_objset(Erule, Name, N, ObjSet,
+ RestFieldNames, Extensible)
+ end,
+ Prefix = lists:concat(["enc_os_",Name]),
+ F = asn1ct_func:call_gen(Prefix, Key, Gen),
+ [{apply,F,[{var,atom_to_list(Val)},{var,Fun}]}].
+
+fix_object_code(Name, [{Name,B}|_], _ClassFields) ->
+ B;
+fix_object_code(Name, [_|T], ClassFields) ->
+ fix_object_code(Name, T, ClassFields);
+fix_object_code(Name, [], ClassFields) ->
+ case lists:keyfind(Name, 2, ClassFields) of
+ {typefield,Name,'OPTIONAL'} ->
+ none;
+ {objectfield,Name,_,_,'OPTIONAL'} ->
+ none;
+ {typefield,Name,{'DEFAULT',#type{}=Type}} ->
+ InnerType = asn1ct_gen:get_inner(Type#type.def),
+ case asn1ct_gen:type(InnerType) of
+ {primitive,bif} ->
+ #typedef{name={primitive,bif},typespec=Type};
+ {constructed,bif} ->
+ #typedef{name={constructed,bif},typespec=Type}
+ end
+ end.
+
+
+enc_objset(Erule, Component, Name, ObjSet, RestFieldNames, Extensible) ->
+ asn1ct_name:start(),
+ Aligned = is_aligned(Erule),
+ E = {error,
+ fun() ->
+ emit(["exit({'Type not compatible with table constraint',"
+ "{component,",{asis,Component},"},"
+ "{value,Val},"
+ "{unique_name_and_value,'_'}})",nl])
+ end},
+ Imm = [{'cond',
+ [[{eq,{var,"Id"},Key}|
+ enc_obj(Erule, Obj, RestFieldNames, Aligned)] ||
+ {Key,Obj} <- ObjSet] ++
+ [['_',case Extensible of
+ false -> E;
+ true -> {put_bits,{var,"Val"},binary,[1]}
+ end]]}],
+ emit([{asis,Name},"(Val, Id) ->",nl]),
+ asn1ct_imm:enc_cg(Imm, Aligned),
+ emit([".",nl]).
+
+enc_obj(Erule, Obj, RestFieldNames0, Aligned) ->
+ case Obj of
+ #typedef{name={primitive,bif},typespec=Def} ->
+ asn1ct_gen_per:gen_encode_prim_imm('Val', Def, Aligned);
+ #typedef{name={constructed,bif},typespec=Def} ->
+ InnerType = asn1ct_gen:get_inner(Def#type.def),
+ case InnerType of
+ 'CHOICE' ->
+ gen_encode_choice_imm(Erule, name, Def);
+ 'SET' ->
+ gen_encode_constructed_imm(Erule, name, Def);
+ 'SET OF' ->
+ gen_encode_sof_imm(Erule, name, InnerType, Def);
+ 'SEQUENCE' ->
+ gen_encode_constructed_imm(Erule, name, Def);
+ 'SEQUENCE OF' ->
+ gen_encode_sof_imm(Erule, name, InnerType, Def)
+ end;
+ #typedef{name=Type} ->
+ [{apply,enc_func(Type),[{var,"Val"}]}];
+ #'Externalvaluereference'{module=Mod,value=Value} ->
+ case asn1_db:dbget(Mod, Value) of
+ #typedef{typespec=#'Object'{def=Def}} ->
+ {object,_,Fields} = Def,
+ [NextField|RestFieldNames] = RestFieldNames0,
+ {NextField,Typedef} = lists:keyfind(NextField, 1, Fields),
+ enc_obj(Erule, Typedef, RestFieldNames, Aligned)
+ end;
+ #'Externaltypereference'{module=Mod,type=Type} ->
+ Func = enc_func(Type),
+ case get(currmod) of
+ Mod ->
+ [{apply,Func,[{var,"Val"}]}];
+ _ ->
+ [{apply,{Mod,Func},[{var,"Val"}]}]
+ end
+ end.
+
+
gen_dec_components_call(Erule, TopType, {Root,ExtList},
DecInfObj, Ext, NumberOfOptionals) ->
gen_dec_components_call(Erule,TopType,{Root,ExtList,[]},
@@ -1163,14 +1174,6 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj,
emit(["{",{curr,tmpterm},", ",{next,bytes},"} = "]),
St
end;
- %%{objectfield,_,_} when Ext == noext, Prop == mandatory ->
- {{objectfield,_,_},true} ->
- fun(St) ->
- asn1ct_name:new(term),
- asn1ct_name:new(tmpterm),
- emit(["{",{curr,tmpterm},", ",{next,bytes},"} = "]),
- St
- end;
_ ->
case Type of
#type{def=#'SEQUENCE'{
@@ -1350,25 +1353,19 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
false -> % This is in a choice with typefield components
{Name,RestFieldNames} =
(Type#type.def)#'ObjectClassFieldType'.fieldname,
-
- asn1ct_name:new(reason),
Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)),
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
{TmpTerm,TempBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar),
+ emit([com,nl]),
+ #type{tablecinf=[{objfun,
+ #'Externaltypereference'{module=Xmod,
+ type=Xtype}}]} =
+ Type,
+ gen_dec_open_type(Erule, "ObjFun", {Xmod,Xtype},
+ '_', {'_',{Name,RestFieldNames},
+ 'Result',TmpTerm,mandatory}),
emit([com,nl,
- {next,bytes}," = ",TempBuf,com,nl,
- indent(2),"case (catch ObjFun(",
- {asis,Name},",",TmpTerm,",telltype,",
- {asis,RestFieldNames},")) of", nl]),
- emit([indent(4),"{'EXIT',",{curr,reason},"} ->",nl]),
- emit([indent(6),"exit({'Type not ",
- "compatible with table constraint', ",
- {curr,reason},"});",nl]),
- asn1ct_name:new(tmpterm),
- emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]),
- emit([indent(6),"{",{asis,Cname},", {",{curr,tmpterm},", ",
- {next,bytes},"}}",nl]),
- emit([indent(2),"end"]),
+ "{",{asis,Cname},",{Result,",TempBuf,"}}"]),
{[],PrevSt};
{"got objfun through args","ObjFun"} ->
%% this is when the generated code gots the
@@ -1388,27 +1385,22 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
asn1ct_imm:dec_code_gen(Imm, BytesVar),
emit([com,nl]),
+ #type{tablecinf=[{objfun,
+ #'Externaltypereference'{module=Xmod,
+ type=Xtype}}]} =
+ Type,
+ Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
+ TmpTerm = asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),
if
Prop =:= mandatory ->
- emit([{curr,term}," =",nl," "]);
- true ->
- emit([" {"])
- end,
- emit(["case (catch ObjFun(",{asis,Name},",",
- {curr,tmpterm},",telltype,",
- {asis,RestFieldNames},")) of", nl]),
- emit([" {'EXIT',",{curr,reason},"} ->",nl]),
- emit([indent(6),"exit({'Type not ",
- "compatible with table constraint', ",
- {curr,reason},"});",nl]),
- asn1ct_name:new(tmpterm),
- emit([indent(4),"{",{curr,tmpterm},", _} ->",nl]),
- emit([indent(6),{curr,tmpterm},nl]),
- emit([indent(2),"end"]),
- if
- Prop =:= mandatory ->
- ok;
+ gen_dec_open_type(Erule, "ObjFun", {Xmod,Xtype},
+ '_', {'_',{Name,RestFieldNames},
+ Term,TmpTerm,Prop});
true ->
+ emit([" {"]),
+ gen_dec_open_type(Erule, "ObjFun", {Xmod,Xtype},
+ '_', {'_',{Name,RestFieldNames},
+ '_',TmpTerm,Prop}),
emit([",",nl,{curr,tmpbytes},"}"])
end,
{[],PrevSt};
@@ -1425,19 +1417,6 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp,
Prop}],PrevSt}
end
end;
-gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType,
- Comp, _DecInfObj) ->
- fun({_BytesVar,PrevSt}) ->
- Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)),
- BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)),
- asn1ct_imm:dec_code_gen(Imm, BytesVar),
- #'ComponentType'{name=Cname,prop=Prop} = Comp,
- SaveBytes = [{Cname,{PrimFieldName1,PFNList},
- asn1ct_gen:mk_var(asn1ct_name:curr(term)),
- asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),
- Prop}],
- {SaveBytes,PrevSt}
- end;
gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) ->
case gen_dec_line_other(Erule, Atype, TopType, Comp) of
Fun when is_function(Fun, 1) ->
@@ -1458,14 +1437,11 @@ gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) ->
gen_dec_line_dec_inf(Comp, DecInfObj) ->
#'ComponentType'{name=Cname} = Comp,
case DecInfObj of
- {Cname,{_,OSet,UniqueFName,ValIndex}} ->
+ {Cname,{_,_OSet,_UniqueFName,ValIndex}} ->
Term = asn1ct_gen:mk_var(asn1ct_name:curr(term)),
ValueMatch = value_match(ValIndex,Term),
- {ObjSetMod,ObjSetName} = OSet,
emit([",",nl,
- "ObjFun = ",{asis,ObjSetMod},
- ":'getdec_",ObjSetName,"'(",
- {asis,UniqueFName},", ",ValueMatch,")"]);
+ "ObjFun = ",ValueMatch]);
_ ->
ok
end.
@@ -1492,63 +1468,35 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) ->
[{objfun,_}|_R] ->
fun(BytesVar) ->
emit({"'dec_",asn1ct_gen:list2name(NewTypename),
- "'(",BytesVar,", telltype, ObjFun)"})
+ "'(",BytesVar,", ObjFun)"})
end;
_ ->
fun(BytesVar) ->
emit({"'dec_",asn1ct_gen:list2name(NewTypename),
- "'(",BytesVar,", telltype)"})
+ "'(",BytesVar,")"})
end
end
end.
-gen_enc_choice(Erule,TopType,CompList,Ext) ->
- gen_enc_choice_tag(Erule, CompList, [], Ext),
- emit({com,nl}),
- emit({"case element(1,Val) of",nl}),
- gen_enc_choice2(Erule,TopType, CompList, Ext),
- emit({nl,"end"}).
-
-gen_enc_choice_tag(Erule, {C1,C2}, _, _) ->
- N1 = get_name_list(C1),
- N2 = get_name_list(C2),
- call(Erule,set_choice,
- ["element(1, Val)",
- {asis,{N1,N2}},
- {asis,{length(N1),length(N2)}}]);
-gen_enc_choice_tag(Erule, {C1,C2,C3}, _, _) ->
- N1 = get_name_list(C1),
- N2 = get_name_list(C2),
- N3 = get_name_list(C3),
- Root = N1 ++ N3,
- call(Erule,set_choice,
- ["element(1, Val)",
- {asis,{Root,N2}},
- {asis,{length(Root),length(N2)}}]);
-gen_enc_choice_tag(Erule, C, _, _) ->
- N = get_name_list(C),
- call(Erule,set_choice,
- ["element(1, Val)",
- {asis,N},{asis,length(N)}]).
-
-get_name_list(L) ->
- get_name_list(L,[]).
-
-get_name_list([#'ComponentType'{name=Name}|T], Acc) ->
- get_name_list(T,[Name|Acc]);
-get_name_list([], Acc) ->
- lists:reverse(Acc).
-
-
-gen_enc_choice2(Erule,TopType, {L1,L2}, Ext) ->
- gen_enc_choice2(Erule, TopType, L1 ++ L2, 0, [], Ext);
-gen_enc_choice2(Erule, TopType, {L1,L2,L3}, Ext) ->
- gen_enc_choice2(Erule, TopType, L1 ++ L3 ++ L2, 0, [], Ext);
-gen_enc_choice2(Erule,TopType, L, Ext) ->
- gen_enc_choice2(Erule,TopType, L, 0, [], Ext).
+gen_enc_choice(Erule, TopType, {Root,Exts}, Ext) ->
+ Constr = choice_constraint(Root),
+ gen_enc_choices(Root, Erule, TopType, 0, Constr, Ext) ++
+ gen_enc_choices(Exts, Erule, TopType, 0, ext, Ext);
+gen_enc_choice(Erule, TopType, {Root,Exts,[]}, Ext) ->
+ gen_enc_choice(Erule, TopType, {Root,Exts}, Ext);
+gen_enc_choice(Erule, TopType, Root, Ext) when is_list(Root) ->
+ Constr = choice_constraint(Root),
+ gen_enc_choices(Root, Erule, TopType, 0, Constr, Ext).
+
+choice_constraint(L) ->
+ case length(L) of
+ 0 -> [{'SingleValue',0}];
+ Len -> [{'ValueRange',{0,Len-1}}]
+ end.
-gen_enc_choice2(Erule, TopType, [H|T], Pos, Sep0, Ext) ->
+gen_enc_choices([H|T], Erule, TopType, Pos, Constr, Ext) ->
#'ComponentType'{name=Cname,typespec=Type} = H,
+ Aligned = is_aligned(Erule),
EncObj =
case asn1ct_gen:get_constraint(Type#type.constraint,
componentrelation) of
@@ -1562,16 +1510,25 @@ gen_enc_choice2(Erule, TopType, [H|T], Pos, Sep0, Ext) ->
_ ->
{no_attr,"ObjFun"}
end,
- emit([Sep0,{asis,Cname}," ->",nl]),
- DoExt = case Ext of
- {ext,ExtPos,_} when Pos + 1 < ExtPos -> noext;
- _ -> Ext
+ DoExt = case Constr of
+ ext -> Ext;
+ _ -> noext
end,
- gen_enc_line(Erule, TopType, Cname, Type, "element(2, Val)",
- Pos+1, EncObj, DoExt),
- Sep = [";",nl],
- gen_enc_choice2(Erule, TopType, T, Pos+1, Sep, Ext);
-gen_enc_choice2(_, _, [], _, _, _) -> ok.
+ Tag = case {Ext,Constr} of
+ {noext,_} ->
+ asn1ct_imm:per_enc_integer(Pos, Constr, Aligned);
+ {{ext,_,_},ext} ->
+ [{put_bits,1,1,[1]}|
+ asn1ct_imm:per_enc_small_number(Pos, Aligned)];
+ {{ext,_,_},_} ->
+ [{put_bits,0,1,[1]}|
+ asn1ct_imm:per_enc_integer(Pos, Constr, Aligned)]
+ end,
+ Body = gen_enc_line_imm(Erule, TopType, Cname, Type, 'ChoiceVal',
+ EncObj, DoExt),
+ Imm = Tag ++ Body,
+ [{Cname,Imm}|gen_enc_choices(T, Erule, TopType, Pos+1, Constr, Ext)];
+gen_enc_choices([], _, _, _, _, _) -> [].
%% Generate the code for CHOICE. If the CHOICE is extensible,
%% the structure of the generated code is as follows:
@@ -1704,9 +1661,6 @@ gen_dec_choice2(Erule, TopType, [H0|T], Pos, Sep0, Pre) ->
gen_dec_choice2(Erule, TopType, T, Pos+1, Sep, Pre);
gen_dec_choice2(_, _, [], _, _, _) -> ok.
-indent(N) ->
- lists:duplicate(N,32). % 32 = space
-
make_elements(I,Val,ExtCnames) ->
make_elements(I,Val,ExtCnames,[]).
@@ -1720,7 +1674,7 @@ make_elements(_I,_,[],Acc) ->
lists:reverse(Acc).
make_element(I, Val) ->
- io_lib:format("element(~w,~s)", [I,Val]).
+ lists:flatten(io_lib:format("element(~w, ~s)", [I,Val])).
emit_extaddgroupTerms(VarSeries,[_]) ->
asn1ct_name:new(VarSeries),
@@ -1787,6 +1741,3 @@ value_match1(Value,[],Acc,Depth) ->
Acc ++ Value ++ lists:concat(lists:duplicate(Depth,")"));
value_match1(Value,[{VI,_}|VIs],Acc,Depth) ->
value_match1(Value,VIs,Acc++lists:concat(["element(",VI,","]),Depth+1).
-
-is_optimized(per) -> true;
-is_optimized(uper) -> false.
diff --git a/lib/asn1/src/asn1ct_eval_per.funcs b/lib/asn1/src/asn1ct_eval_per.funcs
deleted file mode 100644
index a1ea5cd043..0000000000
--- a/lib/asn1/src/asn1ct_eval_per.funcs
+++ /dev/null
@@ -1,2 +0,0 @@
-{per,encode_constrained_number,2}.
-{per,encode_small_number,1}.
diff --git a/lib/asn1/src/asn1ct_eval_uper.funcs b/lib/asn1/src/asn1ct_eval_uper.funcs
deleted file mode 100644
index 884a486f40..0000000000
--- a/lib/asn1/src/asn1ct_eval_uper.funcs
+++ /dev/null
@@ -1,2 +0,0 @@
-{uper,encode_constrained_number,2}.
-{uper,encode_small_number,1}.
diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl
index ab0dbcce8f..dbadedb683 100644
--- a/lib/asn1/src/asn1ct_func.erl
+++ b/lib/asn1/src/asn1ct_func.erl
@@ -19,7 +19,7 @@
%%
-module(asn1ct_func).
--export([start_link/0,need/1,call/3,generate/1]).
+-export([start_link/0,need/1,call/3,call_gen/3,call_gen/4,generate/1]).
-export([init/1,handle_call/3,handle_cast/2,terminate/2]).
start_link() ->
@@ -28,15 +28,33 @@ start_link() ->
ok.
call(M, F, Args) ->
- MFA = {M,F,length(Args)},
+ A = length(Args),
+ MFA = {M,F,A},
need(MFA),
- asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]).
+ case M of
+ binary ->
+ asn1ct_gen:emit(["binary:",F,"(",call_args(Args, ""),")"]);
+ _ ->
+ asn1ct_gen:emit([F,"(",call_args(Args, ""),")"])
+ end.
+need({binary,_,_}) ->
+ ok;
+need({erlang,_,_}) ->
+ ok;
need(MFA) ->
asn1ct_rtt:assert_defined(MFA),
cast({need,MFA}).
+call_gen(Prefix, Key, Gen, Args) when is_function(Gen, 2) ->
+ F = req({gen_func,Prefix,Key,Gen}),
+ asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]).
+
+call_gen(Prefix, Key, Gen) when is_function(Gen, 2) ->
+ req({gen_func,Prefix,Key,Gen}).
+
generate(Fd) ->
+ do_generate(Fd),
Used0 = req(get_used),
erase(?MODULE),
Used = sofs:set(Used0, [mfa]),
@@ -53,10 +71,13 @@ cast(Req) ->
%%% Internal functions.
--record(st, {used}).
+-record(st, {used, %Used functions
+ gen, %Dynamically generated functions
+ gc=1 %Counter for generated functions
+ }).
init([]) ->
- St = #st{used=gb_sets:empty()},
+ St = #st{used=gb_sets:empty(),gen=gb_trees:empty()},
{ok,St}.
handle_cast({need,MFA}, #st{used=Used0}=St) ->
@@ -69,7 +90,20 @@ handle_cast({need,MFA}, #st{used=Used0}=St) ->
end.
handle_call(get_used, _From, #st{used=Used}=St) ->
- {stop,normal,gb_sets:to_list(Used),St}.
+ {stop,normal,gb_sets:to_list(Used),St};
+handle_call(get_gen, _From, #st{gen=G0}=St) ->
+ {L,G} = do_get_gen(gb_trees:to_list(G0), [], []),
+ {reply,L,St#st{gen=gb_trees:from_orddict(G)}};
+handle_call({gen_func,Prefix,Key,GenFun}, _From, #st{gen=G0,gc=Gc0}=St) ->
+ case gb_trees:lookup(Key, G0) of
+ none ->
+ Name = list_to_atom(Prefix ++ integer_to_list(Gc0)),
+ Gc = Gc0 + 1,
+ G = gb_trees:insert(Key, {Name,GenFun}, G0),
+ {reply,Name,St#st{gen=G,gc=Gc}};
+ {value,{Name,_}} ->
+ {reply,Name,St}
+ end.
terminate(_, _) ->
ok.
@@ -98,3 +132,22 @@ update_worklist([H|T], Used, Ws) ->
update_worklist(T, Used, Ws)
end;
update_worklist([], _, Ws) -> Ws.
+
+do_get_gen([{_,{_,done}}=Keep|T], Gacc, Kacc) ->
+ do_get_gen(T, Gacc, [Keep|Kacc]);
+do_get_gen([{K,{Name,_}=V}|T], Gacc, Kacc) ->
+ do_get_gen(T, [V|Gacc], [{K,{Name,done}}|Kacc]);
+do_get_gen([], Gacc, Kacc) ->
+ {lists:sort(Gacc),lists:reverse(Kacc)}.
+
+do_generate(Fd) ->
+ case req(get_gen) of
+ [] ->
+ ok;
+ [_|_]=Gen ->
+ _ = [begin
+ ok = file:write(Fd, "\n"),
+ GenFun(Fd, Name)
+ end || {Name,GenFun} <- Gen],
+ do_generate(Fd)
+ end.
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 9095e145a3..e6ec0cb12b 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -798,7 +798,12 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) ->
gen_exports1(Types,"enc_",1)
end,
emit({"-export([",nl}),
- gen_exports1(Types,"dec_",2)
+ case Erules of
+ ber ->
+ gen_exports1(Types, "dec_", 2);
+ _ ->
+ gen_exports1(Types, "dec_", 1)
+ end
end,
case [X || {n2n,X} <- get(encoding_options)] of
[] -> ok;
@@ -819,10 +824,7 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) ->
_ ->
case erule(Erules) of
per ->
- emit({"-export([",nl}),
- gen_exports1(Objects,"enc_",3),
- emit({"-export([",nl}),
- gen_exports1(Objects,"dec_",4);
+ ok;
ber ->
emit({"-export([",nl}),
gen_exports1(Objects,"enc_",3),
@@ -833,10 +835,15 @@ pgen_exports(Erules,_Module,{Types,Values,_,_,Objects,ObjectSets}) ->
case ObjectSets of
[] -> ok;
_ ->
- emit({"-export([",nl}),
- gen_exports1(ObjectSets,"getenc_",2),
- emit({"-export([",nl}),
- gen_exports1(ObjectSets,"getdec_",2)
+ case erule(Erules) of
+ per ->
+ ok;
+ ber ->
+ emit({"-export([",nl}),
+ gen_exports1(ObjectSets, "getenc_",1),
+ emit({"-export([",nl}),
+ gen_exports1(ObjectSets, "getdec_",1)
+ end
end,
emit({"-export([info/0]).",nl}),
gen_partial_inc_decode_exports(),
@@ -916,15 +923,23 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) ->
{["complete(encode_disp(Type, Data))"],"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,",BytesAsBinary,"};",nl,
- " Bytes ->",nl,
- " {ok,",BytesAsBinary,"}",nl,
+ "try ",Call," of",nl,
+ case erule(Erules) of
+ ber ->
+ [" {Bytes,_Len} ->",nl,
+ " {ok,",BytesAsBinary,"}",nl];
+ per ->
+ [" Bytes ->",nl,
+ " {ok,",BytesAsBinary,"}",nl]
+ end,
+ " catch",nl,
+ " Class:Exception when Class =:= error; Class =:= exit ->",nl,
+ " case Exception of",nl,
+ " {error,Reason}=Error ->",nl,
+ " Error;",nl,
+ " Reason ->",nl,
+ " {error,{asn1,Reason}}",nl,
+ " end",nl,
"end.",nl,nl]),
Return_rest = lists:member(undec_rest,get(encoding_options)),
@@ -999,7 +1014,7 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) ->
gen_partial_inc_dispatcher();
_PerOrPer_bin ->
gen_dispatcher(Types,"encode_disp","enc_",""),
- gen_dispatcher(Types,"decode_disp","dec_",",mandatory")
+ gen_dispatcher(Types,"decode_disp","dec_","")
end,
emit([nl]),
emit({nl,nl}).
diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
index 8ab49aec2c..de81259fcb 100644
--- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
@@ -196,8 +196,16 @@ gen_encode_prim(_Erules, #type{}=D, DoTag, Value) ->
emit(["case ",Value," of",nl]),
emit_enc_enumerated_cases(NamedNumberList,DoTag);
'REAL' ->
- emit([{call,ber,encode_tags,
- [DoTag,{call,real_common,ber_encode_real,[Value]}]}]);
+ asn1ct_name:new(realval),
+ asn1ct_name:new(realsize),
+ emit(["begin",nl,
+ {curr,realval}," = ",
+ {call,real_common,ber_encode_real,[Value]},com,nl,
+ {curr,realsize}," = ",
+ {call,erlang,byte_size,[{curr,realval}]},com,nl,
+ {call,ber,encode_tags,
+ [DoTag,{curr,realval},{curr,realsize}]},nl,
+ "end"]);
{'BIT STRING',NamedNumberList} ->
call(encode_bit_string,
[{asis,BitStringConstraint},Value,
@@ -637,9 +645,6 @@ gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
% ", Val, RestPrimFieldName) ->",nl]),
MaybeConstr=
case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
{false,'OPTIONAL'} ->
EmitFuncClause("Val"),
emit([" {Val,0}"]),
@@ -672,9 +677,6 @@ gen_encode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
% emit(["'enc_",ObjName,"'(",{asis,Name},
% ", Val,[H|T]) ->",nl]),
case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
{false,'OPTIONAL'} ->
EmitFuncClause("_,_"),
emit([" exit({error,{'use of missing field in object', ",{asis,Name},
@@ -807,9 +809,6 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest],
% ", Bytes, RestPrimFieldName) ->",nl]),
MaybeConstr=
case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
{false,'OPTIONAL'} ->
EmitFuncClause(" Bytes"),
emit([" Bytes"]),
@@ -844,9 +843,6 @@ gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
% ", Bytes,[H|T]) ->",nl]),
% emit_tlv_format("Bytes"),
case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
{false,'OPTIONAL'} ->
EmitFuncClause("_,_"),
emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name},
@@ -1072,8 +1068,7 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) ->
gen_objset_enc(Erules, ObjSetName, UniqueName,
[{ObjName,Val,Fields}|T], ClName, ClFields,
NthObj,Acc)->
- emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl]),
+ emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]),
CurrMod = get(currmod),
{InternalFunc,NewNthObj}=
case ObjName of
@@ -1095,7 +1090,7 @@ gen_objset_enc(Erules, ObjSetName, UniqueName,
%% See X.681 Annex E for the following case
gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj,Acc) ->
- emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}),
+ emit(["'getenc_",ObjSetName,"'(_) ->",nl]),
emit({indent(3),"fun(_, Val, _RestPrimFieldName) ->",nl}),
emit({indent(6),"Len = case Val of",nl,indent(9),
"Bin when is_binary(Bin) -> byte_size(Bin);",nl,indent(9),
@@ -1113,7 +1108,7 @@ emit_ext_fun(EncDec,ModuleName,Name) ->
Name,"'(T,V,O) end"]).
emit_default_getenc(ObjSetName,UniqueName) ->
- emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
+ emit(["'getenc_",ObjSetName,"'(ErrV) ->",nl]),
emit([indent(3),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]).
%% gen_inlined_enc_funs for each object iterates over all fields of a
@@ -1240,8 +1235,7 @@ gen_objset_dec(_,_,{unique,undefined},_,_,_,_) ->
ok;
gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T],
ClName, ClFields, NthObj)->
- emit(["'getdec_",ObjSName,"'(",{asis,UniqueName},",",
- {asis,Val},") ->",nl]),
+ emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]),
CurrMod = get(currmod),
NewNthObj=
case ObjName of
@@ -1262,7 +1256,7 @@ gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T],
ClFields, NewNthObj);
gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
_ClFields,_NthObj) ->
- emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]),
+ emit(["'getdec_",ObjSetName,"'(_) ->",nl]),
emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]),
emit([indent(4),"case Bytes of",nl,
@@ -1279,7 +1273,7 @@ gen_objset_dec(_, ObjSetName, UniqueName, [], _, _, _) ->
ok.
emit_default_getdec(ObjSetName,UniqueName) ->
- emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
+ emit(["'getdec_",ObjSetName,"'(ErrV) ->",nl]),
emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]).
gen_inlined_dec_funs(Fields, ClFields, ObjSetName, NthObj) ->
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl
index 69d9d51bf1..8b999ddbf0 100644
--- a/lib/asn1/src/asn1ct_gen_per.erl
+++ b/lib/asn1/src/asn1ct_gen_per.erl
@@ -26,7 +26,7 @@
%-compile(export_all).
-export([gen_dec_imm/2]).
--export([gen_dec_prim/3,gen_encode_prim/3]).
+-export([gen_dec_prim/3,gen_encode_prim_imm/3]).
-export([gen_obj_code/3,gen_objectset_code/2]).
-export([gen_decode/2, gen_decode/3]).
-export([gen_encode/2, gen_encode/3]).
@@ -102,832 +102,106 @@ gen_encode_prim(Erules, D) ->
Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)),
gen_encode_prim(Erules, D, Value).
-gen_encode_prim(Erules, #type{def={'ENUMERATED',{N1,N2}}}, Value) ->
- NewList = [{0,X} || {X,_} <- N1] ++ ['EXT_MARK'] ++
- [{1,X} || {X,_} <- N2],
- NewC = {0,length(N1)-1},
- emit(["case ",Value," of",nl]),
- emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
-gen_encode_prim(Erules, #type{def={'ENUMERATED',NNL}}, Value) ->
- NewList = [X || {X,_} <- NNL],
- NewC = {0,length(NewList)-1},
- emit(["case ",Value," of",nl]),
- emit_enc_enumerated_cases(Erules, NewC, NewList, 0);
-gen_encode_prim(per=Erules, D, Value) ->
- asn1ct_gen_per_rt2ct:gen_encode_prim(Erules, D, Value);
gen_encode_prim(Erules, #type{}=D, Value) ->
- Constraint = D#type.constraint,
- SizeConstr = asn1ct_imm:effective_constraint(bitstring, Constraint),
- Pa = case lists:keyfind('PermittedAlphabet', 1, Constraint) of
- false -> no;
- {_,Pa0} -> Pa0
- end,
- case D#type.def of
+ Aligned = case Erules of
+ uper -> false;
+ per -> true
+ end,
+ Imm = gen_encode_prim_imm(Value, D, Aligned),
+ asn1ct_imm:enc_cg(Imm, Aligned).
+
+gen_encode_prim_imm(Val, #type{def=Type0,constraint=Constraint}, Aligned) ->
+ case simplify_type(Type0) of
+ k_m_string ->
+ Type = case Type0 of
+ 'GeneralizedTime' -> 'VisibleString';
+ 'UTCTime' -> 'VisibleString';
+ _ -> Type0
+ end,
+ asn1ct_imm:per_enc_k_m_string(Val, Type, Constraint, Aligned);
+ restricted_string ->
+ ToBinary = {erlang,iolist_to_binary},
+ asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned);
+ {'ENUMERATED',NNL} ->
+ asn1ct_imm:per_enc_enumerated(Val, NNL, Aligned);
'INTEGER' ->
- Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)},
- Value],
- call(Erules, encode_integer, Args);
- {'INTEGER',NamedNumberList} ->
- Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)},
- Value,{asis,NamedNumberList}],
- call(Erules, encode_integer, Args);
+ asn1ct_imm:per_enc_integer(Val, Constraint, Aligned);
+ {'INTEGER',NNL} ->
+ asn1ct_imm:per_enc_integer(Val, NNL, Constraint, Aligned);
'REAL' ->
- emit_enc_real(Erules, Value);
-
- {'BIT STRING',NamedNumberList} ->
- call(Erules, encode_bit_string,
- [{asis,SizeConstr},Value,
- {asis,NamedNumberList}]);
+ ToBinary = {real_common,encode_real},
+ asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned);
+ {'BIT STRING',NNL} ->
+ asn1ct_imm:per_enc_bit_string(Val, NNL, Constraint, Aligned);
'NULL' ->
- emit("[]");
+ asn1ct_imm:per_enc_null(Val, Aligned);
'OBJECT IDENTIFIER' ->
- call(Erules, encode_object_identifier, [Value]);
+ ToBinary = {per_common,encode_oid},
+ asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned);
'RELATIVE-OID' ->
- call(Erules, encode_relative_oid, [Value]);
- 'ObjectDescriptor' ->
- call(Erules, encode_ObjectDescriptor,
- [{asis,Constraint},Value]);
+ ToBinary = {per_common,encode_relative_oid},
+ asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned);
'BOOLEAN' ->
- call(Erules, encode_boolean, [Value]);
+ asn1ct_imm:per_enc_boolean(Val, Aligned);
'OCTET STRING' ->
- case SizeConstr of
- 0 ->
- emit("[]");
- no ->
- call(Erules, encode_octet_string, [Value]);
- C ->
- call(Erules, encode_octet_string, [{asis,C},Value])
- end;
- 'NumericString' ->
- call(Erules, encode_NumericString, [{asis,SizeConstr},
- {asis,Pa},Value]);
- TString when TString == 'TeletexString';
- TString == 'T61String' ->
- call(Erules, encode_TeletexString, [{asis,Constraint},Value]);
- 'VideotexString' ->
- call(Erules, encode_VideotexString, [{asis,Constraint},Value]);
- 'UTCTime' ->
- call(Erules, encode_VisibleString, [{asis,SizeConstr},
- {asis,Pa},Value]);
- 'GeneralizedTime' ->
- call(Erules, encode_VisibleString, [{asis,SizeConstr},
- {asis,Pa},Value]);
- 'GraphicString' ->
- call(Erules, encode_GraphicString, [{asis,Constraint},Value]);
- 'VisibleString' ->
- call(Erules, encode_VisibleString, [{asis,SizeConstr},
- {asis,Pa},Value]);
- 'GeneralString' ->
- call(Erules, encode_GeneralString, [{asis,Constraint},Value]);
- 'PrintableString' ->
- call(Erules, encode_PrintableString, [{asis,SizeConstr},
- {asis,Pa},Value]);
- 'IA5String' ->
- call(Erules, encode_IA5String, [{asis,SizeConstr},
- {asis,Pa},Value]);
- 'BMPString' ->
- call(Erules, encode_BMPString, [{asis,SizeConstr},
- {asis,Pa},Value]);
- 'UniversalString' ->
- call(Erules, encode_UniversalString, [{asis,SizeConstr},
- {asis,Pa},Value]);
- 'UTF8String' ->
- call(Erules, encode_UTF8String, [Value]);
+ asn1ct_imm:per_enc_octet_string(Val, Constraint, Aligned);
'ASN1_OPEN_TYPE' ->
- NewValue = case Constraint of
- [#'Externaltypereference'{type=Tname}] ->
- asn1ct_func:need({Erules,complete,1}),
- io_lib:format(
- "complete(enc_~s(~s))",[Tname,Value]);
- [#type{def=#'Externaltypereference'{type=Tname}}] ->
- asn1ct_func:need({Erules,complete,1}),
- io_lib:format(
- "complete(enc_~s(~s))",
- [Tname,Value]);
- _ ->
- io_lib:format("iolist_to_binary(~s)",
- [Value])
- end,
- call(Erules, encode_open_type, [NewValue])
- end.
-
-emit_enc_real(Erules, Real) ->
- asn1ct_name:new(tmpval),
- asn1ct_name:new(tmplen),
- emit(["begin",nl,
- "{",{curr,tmpval},com,{curr,tmplen},"} = ",
- {call,real_common,encode_real,[Real]},com,nl,
- "[",{call,Erules,encode_length,[{curr,tmplen}]},",",
- {curr,tmpval},"]",nl,
- "end"]).
-
-emit_enc_enumerated_cases(Erules, C, ['EXT_MARK'|T], _Count) ->
- %% Reset enumeration counter.
- emit_enc_enumerated_cases(Erules, C, T, 0);
-emit_enc_enumerated_cases(Erules, C, [H|T], Count) ->
- emit_enc_enumerated_case(Erules, C, H, Count),
- emit([";",nl]),
- emit_enc_enumerated_cases(Erules, C, T, Count+1);
-emit_enc_enumerated_cases(_Erules, _, [], _Count) ->
- emit(["EnumVal -> "
- "exit({error,{asn1,{enumerated_not_in_range, EnumVal}}})",nl,
- "end"]).
-
-emit_enc_enumerated_case(Erules, C, {0,EnumName}, Count) ->
- %% ENUMERATED with extensionmark; the value lies within then extension root
- Enc = enc_ext_and_val(Erules, 0, encode_constrained_number, [C,Count]),
- emit(["'",EnumName,"' -> ",{asis,Enc}]);
-emit_enc_enumerated_case(Erules, _C, {1,EnumName}, Count) ->
- %% ENUMERATED with extensionmark; the value is higher than extension root
- Enc = enc_ext_and_val(Erules, 1, encode_small_number, [Count]),
- emit(["'",EnumName,"' -> ",{asis,Enc}]);
-emit_enc_enumerated_case(Erules, C, EnumName, Count) ->
- %% ENUMERATED without extension
- EvalMod = eval_module(Erules),
- emit(["'",EnumName,"' -> ",
- {asis,EvalMod:encode_constrained_number(C, Count)}]).
-
-enc_ext_and_val(per, E, F, Args) ->
- [E|apply(asn1ct_eval_per, F, Args)];
-enc_ext_and_val(uper, E, F, Args) ->
- Bs = list_to_bitstring([apply(asn1ct_eval_uper, F, Args)]),
- <<E:1,Bs/bitstring>>.
-
-
-%% Object code generating for encoding and decoding
-%% ------------------------------------------------
-
-gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) ->
- ObjName = Obj#typedef.name,
- Def = Obj#typedef.typespec,
- #'Externaltypereference'{module=Mod,type=ClassName} =
- Def#'Object'.classname,
- Class = asn1_db:dbget(Mod,ClassName),
- {object,_,Fields} = Def#'Object'.def,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjName}),
- emit({nl,"%%================================",nl}),
- EncConstructed =
- gen_encode_objectfields(Erules, ClassName,get_class_fields(Class),
- ObjName,Fields,[]),
- emit(nl),
- gen_encode_constr_type(Erules,EncConstructed),
- emit(nl),
- DecConstructed =
- gen_decode_objectfields(Erules, ClassName, get_class_fields(Class),
- ObjName, Fields, []),
- emit(nl),
- gen_decode_constr_type(Erules,DecConstructed),
- emit(nl).
-
-
-gen_encode_objectfields(Erule, ClassName,
- [{typefield,Name,OptOrMand}|Rest],
- ObjName, ObjectFields, ConstrAcc) ->
- EmitFuncClause =
- fun(V) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
- ",",V,",_RestPrimFieldName) ->",nl])
- end,
-% emit(["'enc_",ObjName,"'(",{asis,Name},
-% ", Val, _RestPrimFieldName) ->",nl]),
- MaybeConstr =
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("Val"),
- case Erule of
- uper ->
- emit(" Val");
- per ->
- emit([" if",nl,
- " is_list(Val) ->",nl,
- " NewVal = list_to_binary(Val),",nl,
- " [20,byte_size(NewVal),NewVal];",nl,
- " is_binary(Val) ->",nl,
- " [20,byte_size(Val),Val]",nl,
- " end"])
- end,
- [];
- {false,{'DEFAULT',DefaultType}} ->
- EmitFuncClause("Val"),
- gen_encode_default_call(Erule, ClassName, Name, DefaultType);
- {{Name,TypeSpec},_} ->
- %% A specified field owerwrites any 'DEFAULT' or
- %% 'OPTIONAL' field in the class
- EmitFuncClause("Val"),
- gen_encode_field_call(Erule, ObjName, Name, TypeSpec)
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_encode_objectfields(Erule,ClassName,Rest,ObjName,ObjectFields,
- MaybeConstr++ConstrAcc);
-gen_encode_objectfields(Erule,ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName,ObjectFields,ConstrAcc) ->
- CurrentMod = get(currmod),
- EmitFuncClause =
- fun(Attrs) ->
- emit(["'enc_",ObjName,"'(",{asis,Name},
- ",",Attrs,") ->",nl])
- end,
-% emit(["'enc_",ObjName,"'(",{asis,Name},
-% ", Val,[H|T]) ->",nl]),
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("_,_"),
- emit([" exit({error,{'use of missing field in object', ",{asis,Name},
- "}})"]);
- {false,{'DEFAULT',_DefaultObject}} ->
- exit({error,{asn1,{"not implemented yet",Name}}});
- {{Name,#'Externalvaluereference'{module=CurrentMod,
- value=TypeName}},_} ->
- EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"});
- {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
- EmitFuncClause(" Val, [H|T]"),
- emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"});
- {{Name,TypeSpec},_} ->
- EmitFuncClause("Val,[H|T]"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'enc_",TypeName,
- "'(H, Val, T)"});
- TypeName ->
- emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"})
+ case Constraint of
+ [#'Externaltypereference'{type=Tname}] ->
+ EncFunc = enc_func(Tname),
+ Imm = [{apply,EncFunc,[{expr,Val}]}],
+ asn1ct_imm:per_enc_open_type(Imm, Aligned);
+ [] ->
+ Imm = [{call,erlang,iolist_to_binary,[{expr,Val}]}],
+ asn1ct_imm:per_enc_open_type(Imm, Aligned)
end
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_encode_objectfields(Erule,ClassName,Rest,ObjName,ObjectFields,ConstrAcc);
-gen_encode_objectfields(Erule,ClassName,[_C|Cs],O,OF,Acc) ->
- gen_encode_objectfields(Erule,ClassName,Cs,O,OF,Acc);
-gen_encode_objectfields(_, _,[],_,_,Acc) ->
- Acc.
-
-
-gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
- case is_already_generated(enc,TypeDef#typedef.name) of
- true -> ok;
- _ ->
-%% FuncName = list_to_atom(lists:concat(["enc_",TypeDef#typedef.name])),
- FuncName = asn1ct_gen:list2rname(TypeDef#typedef.name ++ [enc]),
- emit(["'",FuncName,"'(Val) ->",nl]),
- Def = TypeDef#typedef.typespec,
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- asn1ct_gen:gen_encode_constructed(Erules,TypeDef#typedef.name,
- InnerType,Def),
- gen_encode_constr_type(Erules,Rest)
- end;
-gen_encode_constr_type(_,[]) ->
- ok.
-
-gen_encode_field_call(_Erules, _ObjName, _FieldName,
- #'Externaltypereference'{module=M,type=T}) ->
- CurrentMod = get(currmod),
- if
- M == CurrentMod ->
- emit({" 'enc_",T,"'(Val)"}),
- [];
- true ->
- emit({" '",M,"':'enc_",T,"'(Val)"}),
- []
- end;
-gen_encode_field_call(Erules, ObjName, FieldName, Type) ->
- Def = Type#typedef.typespec,
- case Type#typedef.name of
- {primitive,bif} ->
- gen_encode_prim(Erules, Def, "Val"),
- [];
- {constructed,bif} ->
- emit({" 'enc_",ObjName,'_',FieldName,
- "'(Val)"}),
-%% [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
- [Type#typedef{name=[FieldName,ObjName]}];
- {ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'enc_",TypeName,
- "'(Val)"}),
- [];
- TypeName ->
- emit({" 'enc_",TypeName,"'(Val)"}),
- []
end.
-gen_encode_default_call(Erules, ClassName, FieldName, Type) ->
- CurrentMod = get(currmod),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
-%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type);
- emit([" 'enc_",ClassName,'_',FieldName,"'(Val)"]),
-%% [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
- [#typedef{name=[FieldName,ClassName],
- typespec=Type}];
- {primitive,bif} ->
- gen_encode_prim(Erules, Type, "Val"),
- [];
- #'Externaltypereference'{module=CurrentMod,type=Etype} ->
- emit([" 'enc_",Etype,"'(Val)",nl]),
- [];
- #'Externaltypereference'{module=Emod,type=Etype} ->
- emit([" '",Emod,"':'enc_",Etype,"'(Val)",nl]),
- []
- end.
-
-
-gen_decode_objectfields(Erules, ClassName,
- [{typefield,Name,OptOrMand}|Rest],
- ObjName, ObjectFields, ConstrAcc) ->
- EmitFuncClause =
- fun(Bytes) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes,
- ",_,_RestPrimFieldName) ->",nl])
- end,
- MaybeConstr=
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} -> %% this case is illegal
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("Bytes"),
- emit([" {Bytes,[]}"]),
- [];
- {false,{'DEFAULT',DefaultType}} ->
- EmitFuncClause("Bytes"),
- gen_decode_default_call(Erules, ClassName, Name, "Bytes",
- DefaultType);
- {{Name,TypeSpec},_} ->
- %% A specified field owerwrites any 'DEFAULT' or
- %% 'OPTIONAL' field in the class
- EmitFuncClause("Bytes"),
- gen_decode_field_call(Erules, ObjName, Name, "Bytes", TypeSpec)
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_decode_objectfields(Erules, ClassName, Rest, ObjName,
- ObjectFields, MaybeConstr++ConstrAcc);
-gen_decode_objectfields(Erules, ClassName,
- [{objectfield,Name,_,_,OptOrMand}|Rest],
- ObjName, ObjectFields, ConstrAcc) ->
- CurrentMod = get(currmod),
- EmitFuncClause =
- fun(Attrs) ->
- emit(["'dec_",ObjName,"'(",{asis,Name},
- ",",Attrs,") ->",nl])
- end,
-% emit(["'dec_",ObjName,"'(",{asis,Name},
-% ", Bytes,_,[H|T]) ->",nl]),
- case {get_object_field(Name,ObjectFields),OptOrMand} of
- {false,'MANDATORY'} ->
- exit({error,{asn1,{"missing mandatory field in object",
- ObjName}}});
- {false,'OPTIONAL'} ->
- EmitFuncClause("_,_,_"),
- emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name},
- "}})"]);
- {false,{'DEFAULT',_DefaultObject}} ->
- exit({error,{asn1,{"not implemented yet",Name}}});
- {{Name,#'Externalvaluereference'{module=CurrentMod,
- value=TypeName}},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"});
- {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- emit({indent(3),"'",M,"':'dec_",TypeName,
- "'(H, Bytes, telltype, T)"});
- {{Name,TypeSpec},_} ->
- EmitFuncClause("Bytes,_,[H|T]"),
- case TypeSpec#typedef.name of
- {ExtMod,TypeName} ->
- emit({indent(3),"'",ExtMod,"':'dec_",TypeName,
- "'(H, Bytes, telltype, T)"});
- TypeName ->
- emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"})
- end
- end,
- case more_genfields(Rest) of
- true ->
- emit([";",nl]);
- false ->
- emit([".",nl])
- end,
- gen_decode_objectfields(Erules, ClassName, Rest, ObjName,
- ObjectFields, ConstrAcc);
-gen_decode_objectfields(Erules, CN, [_C|Cs], O, OF, CAcc) ->
- gen_decode_objectfields(Erules, CN, Cs, O, OF, CAcc);
-gen_decode_objectfields(_, _, [], _, _, CAcc) ->
- CAcc.
-
-
-
-gen_decode_field_call(_Erules, _ObjName, _FieldName, Bytes,
- #'Externaltypereference'{}=Etype) ->
- emit(" "),
- gen_dec_external(Etype, Bytes),
- [];
-gen_decode_field_call(Erules, ObjName, FieldName, Bytes, Type) ->
- Def = Type#typedef.typespec,
- case Type#typedef.name of
- {primitive,bif} ->
- gen_dec_prim(Erules, Def, Bytes),
- [];
- {constructed,bif} ->
- emit({" 'dec_",ObjName,'_',FieldName,
- "'(",Bytes,",telltype)"}),
-%% [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}];
- [Type#typedef{name=[FieldName,ObjName]}];
- {ExtMod,TypeName} ->
- emit({" '",ExtMod,"':'dec_",TypeName,
- "'(",Bytes,", telltype)"}),
- [];
- TypeName ->
- emit({" 'dec_",TypeName,"'(",Bytes,", telltype)"}),
- []
- end.
-
-gen_decode_default_call(Erules, ClassName, FieldName, Bytes, Type) ->
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- case asn1ct_gen:type(InnerType) of
- {constructed,bif} ->
- emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,", telltype)"]),
-%% [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])),
- [#typedef{name=[FieldName,ClassName],
- typespec=Type}];
- {primitive,bif} ->
- gen_dec_prim(Erules, Type, Bytes),
- [];
- #'Externaltypereference'{}=Etype ->
- asn1ct_gen_per:gen_dec_external(Etype, Bytes),
- []
+dec_func(Tname) ->
+ list_to_atom(lists:concat(["dec_",Tname])).
+
+enc_func(Tname) ->
+ list_to_atom(lists:concat(["enc_",Tname])).
+
+simplify_type(Type) ->
+ case Type of
+ 'BMPString' -> k_m_string;
+ 'IA5String' -> k_m_string;
+ 'NumericString' -> k_m_string;
+ 'PrintableString' -> k_m_string;
+ 'VisibleString' -> k_m_string;
+ 'UniversalString' -> k_m_string;
+ 'GeneralizedTime' -> k_m_string;
+ 'UTCTime' -> k_m_string;
+ 'TeletexString' -> restricted_string;
+ 'T61String' -> restricted_string;
+ 'VideotexString' -> restricted_string;
+ 'GraphicString' -> restricted_string;
+ 'GeneralString' -> restricted_string;
+ 'UTF8String' -> restricted_string;
+ 'ObjectDescriptor' -> restricted_string;
+ Other -> Other
end.
+%% Object code generating for encoding and decoding
+%% ------------------------------------------------
-gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) ->
- case is_already_generated(dec,TypeDef#typedef.name) of
- true -> ok;
- _ ->
- gen_decode(Erules,TypeDef#typedef{name=asn1ct_gen:list2rname(TypeDef#typedef.name)})
- end,
- gen_decode_constr_type(Erules,Rest);
-gen_decode_constr_type(_,[]) ->
+gen_obj_code(_Erules, _Module, #typedef{}) ->
ok.
-
-more_genfields([]) ->
- false;
-more_genfields([Field|Fields]) ->
- case element(1,Field) of
- typefield ->
- true;
- objectfield ->
- true;
- _ ->
- more_genfields(Fields)
- end.
-
%% Object Set code generating for encoding and decoding
%% ----------------------------------------------------
-gen_objectset_code(Erules,ObjSet) ->
- ObjSetName = ObjSet#typedef.name,
- Def = ObjSet#typedef.typespec,
-%% {ClassName,ClassDef} = Def#'ObjectSet'.class,
- #'Externaltypereference'{module=ClassModule,
- type=ClassName} = Def#'ObjectSet'.class,
- ClassDef = asn1_db:dbget(ClassModule,ClassName),
- UniqueFName = Def#'ObjectSet'.uniquefname,
- Set = Def#'ObjectSet'.set,
- emit({nl,nl,nl,"%%================================"}),
- emit({nl,"%% ",ObjSetName}),
- emit({nl,"%%================================",nl}),
- case ClassName of
- {_Module,ExtClassName} ->
- gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
- ExtClassName,ClassDef);
- _ ->
- gen_objset_code(Erules,ObjSetName,UniqueFName,Set,
- ClassName,ClassDef)
- end,
- emit(nl).
-
-gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)->
- ClassFields = (ClassDef#classdef.typespec)#objectclass.fields,
- InternalFuncs=
- gen_objset_enc(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]),
- gen_objset_dec(Erules, ObjSetName,UniqueFName,Set,ClassName,ClassFields,1),
- gen_internal_funcs(Erules,InternalFuncs).
-
-%% gen_objset_enc iterates over the objects of the object set
-gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) ->
- %% There is no unique field in the class of this object set
- %% don't bother about the constraint
- [];
-gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T],
- ClName, ClFields, NthObj, Acc)->
- emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl]),
- CurrMod = get(currmod),
- {InternalFunc,NewNthObj}=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_enc_funs(Erule, Fields, ClFields,
- ObjSetName, NthObj);
- {CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
- {[],0};
- {ModName,Name} ->
- emit_ext_encfun(ModName,Name),
- {[],0};
- _Other ->
- emit({" fun 'enc_",ObjName,"'/3"}),
- {[],0}
- end,
- emit({";",nl}),
- gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields,
- NewNthObj, InternalFunc ++ Acc);
-gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
- _ClName, _ClFields, _NthObj, Acc) ->
- emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}),
- emit({indent(3),"fun(_, Val, _) ->",nl}),
- emit([indent(6),"Val",nl,
- indent(3),"end.",nl,nl]),
- Acc;
-gen_objset_enc(per, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
- _ClName, _ClFields, _NthObj, Acc) ->
- emit(["'getenc_",ObjSetName,"'(_, _) ->",nl,
- indent(3),"fun(_, Val, _) ->",nl,
- indent(6),"BinVal = if",nl,
- indent(9),"is_list(Val) -> list_to_binary(Val);",nl,
- indent(9),"true -> Val",nl,
- indent(6),"end,",nl,
- indent(6),"Size = byte_size(BinVal),",nl,
- indent(6),"if",nl,
- indent(9),"Size < 256 ->",nl,
- indent(12),"[20,Size,BinVal];",nl,
- indent(9),"true ->",nl,
- indent(12),"[21,<<Size:16>>,Val]",nl,
- indent(6),"end",nl,
- indent(3),"end.",nl,nl]),
- Acc;
-gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) ->
- emit_default_getenc(ObjSetName, UniqueName),
- emit([".",nl,nl]),
- Acc.
-
-emit_ext_encfun(ModuleName,Name) ->
- emit([indent(4),"fun(T,V,O) -> '",ModuleName,"':'enc_",
- Name,"'(T,V,O) end"]).
-
-emit_default_getenc(ObjSetName,UniqueName) ->
- emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
- emit([indent(4),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-
-
-%% gen_inlined_enc_funs for each object iterates over all fields of a
-%% class, and for each typefield it checks if the object has that
-%% field and emits the proper code.
-gen_inlined_enc_funs(Erule, Fields, [{typefield,_,_}|_]=T,
- ObjSetName, NthObj) ->
- emit([indent(3),"fun(Type, Val, _) ->",nl,
- indent(6),"case Type of",nl]),
- gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, [], NthObj, []);
-gen_inlined_enc_funs(Erule,Fields,[_H|Rest],ObjSetName,NthObj) ->
- gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj);
-gen_inlined_enc_funs(_,_,[],_,NthObj) ->
- {[],NthObj}.
-
-gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName,
- Sep0, NthObj, Acc0) ->
- emit(Sep0),
- Sep = [";",nl],
- CurrentMod = get(currmod),
- InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]),
- {Acc,NAdd} =
- case lists:keyfind(Name, 1, Fields) of
- {_,#type{}=Type} ->
- {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName),
- {Ret++Acc0,N};
- {_,#typedef{}=Type} ->
- emit([indent(9),{asis,Name}," ->",nl]),
- {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName),
- {Ret++Acc0,N};
- {_,#'Externaltypereference'{module=CurrentMod,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'enc_",T,"'(Val)"]),
- {Acc0,0};
- {_,#'Externaltypereference'{module=M,type=T}} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
- {Acc0,0};
- false when Erule =:= uper ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"Val",nl]),
- {Acc0,0};
- false when Erule =:= per ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12),"Size = case Val of",nl,
- indent(15),"B when is_binary(B) -> size(B);",nl,
- indent(15),"_ -> length(Val)",nl,
- indent(12),"end,",nl,
- indent(12),"if",nl,
- indent(15),"Size < 256 -> [20,Size,Val];",nl,
- indent(15),"true -> [21,<<Size:16>>,Val]",nl,
- indent(12),"end"]),
- {Acc0,0}
- end,
- gen_inlined_enc_funs1(Erule, Fields, Rest, ObjSetName, Sep,
- NthObj+NAdd, Acc);
-gen_inlined_enc_funs1(Erule, Fields, [_|T], ObjSetName, Sep, NthObj, Acc)->
- gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, Sep, NthObj, Acc);
-gen_inlined_enc_funs1(_, _, [], _, _, NthObj, Acc) ->
- emit([nl,indent(6),"end",nl,
- indent(3),"end"]),
- {Acc,NthObj}.
-
-emit_inner_of_fun(Erule, #typedef{name={ExtMod,Name},typespec=Type}=TDef,
- InternalDefFunName) ->
- case {ExtMod,Name} of
- {primitive,bif} ->
- emit(indent(12)),
- gen_encode_prim(Erule, Type, "Val"),
- {[],0};
- {constructed,bif} ->
- emit([indent(12),"'enc_",
- InternalDefFunName,"'(Val)"]),
- {[TDef#typedef{name=InternalDefFunName}],1};
- _ ->
- emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}),
- {[],0}
- end;
-emit_inner_of_fun(_Erule, #typedef{name=Name}, _) ->
- emit({indent(12),"'enc_",Name,"'(Val)"}),
- {[],0};
-emit_inner_of_fun(Erule, #type{}=Type, _) ->
- CurrMod = get(currmod),
- case Type#type.def of
- Def when is_atom(Def) ->
- emit({indent(9),Def," ->",nl,indent(12)}),
- gen_encode_prim(Erule, Type, "Val");
- #'Externaltypereference'{module=CurrMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"});
- #'Externaltypereference'{module=ExtMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_",
- T,"'(Val)"})
- end,
- {[],0}.
-
-indent(N) ->
- lists:duplicate(N,32). % 32 = space
-
-
-gen_objset_dec(_, _, {unique,undefined}, _, _, _, _) ->
- %% There is no unique field in the class of this object set
- %% don't bother about the constraint
- ok;
-gen_objset_dec(Erule, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName,
- ClFields, NthObj)->
- emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},
- ") ->",nl}),
- CurrMod = get(currmod),
- NewNthObj=
- case ObjName of
- {no_mod,no_name} ->
- gen_inlined_dec_funs(Erule, Fields, ClFields,
- ObjSName, NthObj);
- {CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/4"]),
- NthObj;
- {ModName,Name} ->
- emit_ext_decfun(ModName,Name),
- NthObj;
- _Other ->
- emit({" fun 'dec_",ObjName,"'/4"}),
- NthObj
- end,
- emit({";",nl}),
- gen_objset_dec(Erule, ObjSName, UniqueName, T, ClName, ClFields, NewNthObj);
-gen_objset_dec(_Erule, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
- _ClName, _ClFields, _NthObj) ->
- emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}),
- emit({indent(3),"fun(Attr1, Bytes, _,_) ->",nl}),
- emit({indent(6),"{Bytes,Attr1}",nl}),
- emit({indent(3),"end.",nl,nl}),
- ok;
-gen_objset_dec(_Erule, ObjSetName, UniqueName, [], _, _, _) ->
- emit_default_getdec(ObjSetName, UniqueName),
- emit([".",nl,nl]),
+gen_objectset_code(_Erules, _ObjSet) ->
ok.
-emit_ext_decfun(ModuleName,Name) ->
- emit([indent(3),"fun(T,V,O1,O2) -> '",ModuleName,"':'dec_",
- Name,"'(T,V,O1,O2) end"]).
-
-emit_default_getdec(ObjSetName,UniqueName) ->
- emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]),
- emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]).
-
-
-gen_inlined_dec_funs(Erule, Fields, List, ObjSetName, NthObj0) ->
- emit([indent(3),"fun(Type, Val, _, _) ->",nl,
- indent(6),"case Type of",nl]),
- NthObj = gen_inlined_dec_funs1(Erule, Fields, List,
- ObjSetName, "", NthObj0),
- emit([nl,indent(6),"end",nl,
- indent(3),"end"]),
- NthObj.
-
-gen_inlined_dec_funs1(Erule, Fields, [{typefield,Name,_}|Rest],
- ObjSetName, Sep0, NthObj) ->
- InternalDefFunName = [NthObj,Name,ObjSetName],
- emit(Sep0),
- Sep = [";",nl],
- N = case lists:keyfind(Name, 1, Fields) of
- {_,#type{}=Type} ->
- emit_inner_of_decfun(Erule, Type, InternalDefFunName);
- {_,#typedef{}=Type} ->
- emit([indent(9),{asis,Name}," ->",nl]),
- emit_inner_of_decfun(Erule, Type, InternalDefFunName);
- {_,#'Externaltypereference'{}=Etype} ->
- emit([indent(9),{asis,Name}," ->",nl,
- indent(12)]),
- gen_dec_external(Etype, "Val"),
- 0;
- false ->
- emit([indent(9),{asis,Name}," -> {Val,Type}"]),
- 0
- end,
- gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj+N);
-gen_inlined_dec_funs1(Erule, Fields, [_|Rest], ObjSetName, Sep, NthObj) ->
- gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj);
-gen_inlined_dec_funs1(_, _, [], _, _, NthObj) -> NthObj.
-
-emit_inner_of_decfun(Erule, #typedef{name={ExtName,Name},typespec=Type},
- InternalDefFunName) ->
- case {ExtName,Name} of
- {primitive,bif} ->
- emit(indent(12)),
- gen_dec_prim(Erule, Type, "Val"),
- 0;
- {constructed,bif} ->
- emit({indent(12),"'dec_",
- asn1ct_gen:list2name(InternalDefFunName),"'(Val)"}),
- 1;
- _ ->
- emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Val, telltype)"}),
- 0
- end;
-emit_inner_of_decfun(_Erule, #typedef{name=Name}, _) ->
- emit({indent(12),"'dec_",Name,"'(Val, telltype)"}),
- 0;
-emit_inner_of_decfun(Erule, #type{}=Type, _) ->
- CurrMod = get(currmod),
- case Type#type.def of
- Def when is_atom(Def) ->
- emit({indent(9),Def," ->",nl,indent(12)}),
- gen_dec_prim(Erule, Type, "Val");
- #'Externaltypereference'{module=CurrMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"});
- #'Externaltypereference'{module=ExtMod,type=T} ->
- emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_",
- T,"'(Val)"})
- end,
- 0.
-
-
-gen_internal_funcs(_,[]) ->
- ok;
-gen_internal_funcs(Erules,[TypeDef|Rest]) ->
- gen_encode_user(Erules,TypeDef),
- emit([nl,nl,"'dec_",TypeDef#typedef.name,"'(Bytes) ->",nl]),
- gen_decode_user(Erules,TypeDef),
- gen_internal_funcs(Erules,Rest).
-
-
-
%% DECODING *****************************
%%***************************************
-gen_decode(Erules,Type) when is_record(Type,typedef) ->
- D = Type,
- emit({nl,nl}),
- emit({"'dec_",Type#typedef.name,"'(Bytes,_) ->",nl}),
+gen_decode(Erules, #typedef{}=Type) ->
+ DecFunc = dec_func(Type#typedef.name),
+ emit([nl,nl,{asis,DecFunc},"(Bytes) ->",nl]),
dbdec(Type#typedef.name),
- gen_decode_user(Erules,D).
+ gen_decode_user(Erules, Type).
gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) ->
NewTname = [Cname|Tname],
@@ -944,8 +218,9 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) ->
_ ->
""
end,
- emit({nl,"'dec_",asn1ct_gen:list2name(Typename),
- "'(Bytes,_",ObjFun,") ->",nl}),
+ emit([nl,
+ {asis,dec_func(asn1ct_gen:list2name(Typename))},
+ "(Bytes",ObjFun,") ->",nl]),
dbdec(Typename),
asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type);
_ ->
@@ -982,8 +257,8 @@ gen_dec_external(Ext, BytesVar) ->
#'Externaltypereference'{module=Mod,type=Type} = Ext,
emit([case CurrMod of
Mod -> [];
- _ -> ["'",Mod,"':"]
- end,"'dec_",Type,"'(",BytesVar,",telltype)"]).
+ _ -> [{asis,Mod},":"]
+ end,{asis,dec_func(Type)},"(",BytesVar,")"]).
gen_dec_imm(Erule, #type{def=Name,constraint=C}) ->
Aligned = case Erule of
@@ -1103,35 +378,6 @@ gen_dec_prim(Erule, Type, BytesVar) ->
Imm = gen_dec_imm(Erule, Type),
asn1ct_imm:dec_code_gen(Imm, BytesVar).
-is_already_generated(Operation,Name) ->
- case get(class_default_type) of
- undefined ->
- put(class_default_type,[{Operation,Name}]),
- false;
- GeneratedList ->
- case lists:member({Operation,Name},GeneratedList) of
- true ->
- true;
- false ->
- put(class_default_type,[{Operation,Name}|GeneratedList]),
- false
- end
- end.
-
-get_class_fields(#classdef{typespec=ObjClass}) ->
- ObjClass#objectclass.fields;
-get_class_fields(#objectclass{fields=Fields}) ->
- Fields;
-get_class_fields(_) ->
- [].
-
-
-get_object_field(Name,ObjectFields) ->
- case lists:keysearch(Name,1,ObjectFields) of
- {value,Field} -> Field;
- false -> false
- end.
-
%% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding
%% the components within the ExtensionAdditionGroup is treated in a similar way as if they
@@ -1170,11 +416,8 @@ imm_dec_open_type_1(Type, Aligned) ->
asn1ct_name:new(tmpval),
emit(["begin",nl,
"{",{curr,tmpval},",_} = ",
- "dec_",Type,"(",OpenType,", mandatory),",nl,
+ {asis,dec_func(Type)},"(",OpenType,"),",nl,
"{",{curr,tmpval},com,Buf,"}",nl,
"end"])
end,
{call,D,asn1ct_imm:per_dec_open_type(Aligned)}.
-
-eval_module(per) -> asn1ct_eval_per;
-eval_module(uper) -> asn1ct_eval_uper.
diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
deleted file mode 100644
index 012d54e7a1..0000000000
--- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
+++ /dev/null
@@ -1,461 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-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
-%% 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 online 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.
-%%
-%% %CopyrightEnd%
-%%
-%%
--module(asn1ct_gen_per_rt2ct).
-
-%% Handle encoding of primitives for aligned PER.
-
--include("asn1_records.hrl").
-
--export([gen_encode_prim/3]).
-
--import(asn1ct_gen, [emit/1,demit/1]).
--import(asn1ct_func, [call/3]).
-
-gen_encode_prim(Erules, #type{}=D, Value) ->
- Constraint = D#type.constraint,
- case D#type.def of
- 'INTEGER' ->
- EffectiveConstr = effective_constraint(integer,Constraint),
- emit([" %%INTEGER with effective constraint: ",
- {asis,EffectiveConstr},nl]),
- emit_enc_integer(Erules,EffectiveConstr,Value);
- {'INTEGER',NamedNumberList} ->
- EffectiveConstr = effective_constraint(integer,Constraint),
- %% maybe an emit_enc_NNL_integer
- emit([" %%INTEGER with effective constraint: ",
- {asis,EffectiveConstr},nl]),
- emit_enc_integer_NNL(Erules,EffectiveConstr,Value,NamedNumberList);
- 'REAL' ->
- emit_enc_real(Erules, Value);
-
- {'BIT STRING',NamedNumberList} ->
- EffectiveC = effective_constraint(bitstring,Constraint),
- case EffectiveC of
- 0 ->
- emit({"[]"});
- _ ->
- call(Erules, encode_bit_string,
- [{asis,EffectiveC},Value,
- {asis,NamedNumberList}])
- end;
- 'NULL' ->
- emit("[]");
- 'OBJECT IDENTIFIER' ->
- call(Erules, encode_object_identifier, [Value]);
- 'RELATIVE-OID' ->
- call(Erules, encode_relative_oid, [Value]);
- 'ObjectDescriptor' ->
- call(Erules, encode_ObjectDescriptor,
- [{asis,Constraint},Value]);
- 'BOOLEAN' ->
- emit({"case ",Value," of",nl,
- " true -> [1];",nl,
- " false -> [0];",nl,
- " _ -> exit({error,{asn1,{encode_boolean,",Value,"}}})",nl,
- "end"});
- 'OCTET STRING' ->
- emit_enc_octet_string(Erules,Constraint,Value);
-
- 'NumericString' ->
- emit_enc_known_multiplier_string('NumericString',Constraint,Value);
- TString when TString == 'TeletexString';
- TString == 'T61String' ->
- call(Erules, encode_TeletexString, [{asis,Constraint},Value]);
- 'VideotexString' ->
- call(Erules, encode_VideotexString, [{asis,Constraint},Value]);
- 'UTCTime' ->
- emit_enc_known_multiplier_string('VisibleString',Constraint,Value);
- 'GeneralizedTime' ->
- emit_enc_known_multiplier_string('VisibleString',Constraint,Value);
- 'GraphicString' ->
- call(Erules, encode_GraphicString, [{asis,Constraint},Value]);
- 'VisibleString' ->
- emit_enc_known_multiplier_string('VisibleString',Constraint,Value);
- 'GeneralString' ->
- call(Erules, encode_GeneralString, [{asis,Constraint},Value]);
- 'PrintableString' ->
- emit_enc_known_multiplier_string('PrintableString',Constraint,Value);
- 'IA5String' ->
- emit_enc_known_multiplier_string('IA5String',Constraint,Value);
- 'BMPString' ->
- emit_enc_known_multiplier_string('BMPString',Constraint,Value);
- 'UniversalString' ->
- emit_enc_known_multiplier_string('UniversalString',Constraint,Value);
- 'UTF8String' ->
- call(Erules, encode_UTF8String, [Value]);
- 'ASN1_OPEN_TYPE' ->
- NewValue = case Constraint of
- [#'Externaltypereference'{type=Tname}] ->
- asn1ct_func:need({Erules,complete,1}),
- io_lib:format(
- "complete(enc_~s(~s))",[Tname,Value]);
- [#type{def=#'Externaltypereference'{type=Tname}}] ->
- asn1ct_func:need({Erules,complete,1}),
- io_lib:format(
- "complete(enc_~s(~s))",
- [Tname,Value]);
- _ ->
- io_lib:format("iolist_to_binary(~s)",
- [Value])
- end,
- call(Erules, encode_open_type, [NewValue])
- end.
-
-emit_enc_real(Erules, Real) ->
- asn1ct_name:new(tmpval),
- asn1ct_name:new(tmplen),
- emit(["begin",nl,
- "{",{curr,tmpval},com,{curr,tmplen},"} = ",
- {call,real_common,encode_real,[Real]},com,nl,
- "[",{call,Erules,encode_length,[{curr,tmplen}]},",",nl,
- {call,Erules,octets_to_complete,
- [{curr,tmplen},{curr,tmpval}]},"]",nl,
- "end"]).
-
-emit_enc_known_multiplier_string(StringType,C,Value) ->
- SizeC = effective_constraint(bitstring, C),
- PAlphabC = get_constraint(C,'PermittedAlphabet'),
- case {StringType,PAlphabC} of
- {'UniversalString',{_,_}} ->
- exit({error,{asn1,{'not implemented',"UniversalString with "
- "PermittedAlphabet constraint"}}});
- {'BMPString',{_,_}} ->
- exit({error,{asn1,{'not implemented',"BMPString with "
- "PermittedAlphabet constraint"}}});
- _ -> ok
- end,
- NumBits = get_NumBits(C,StringType),
- CharOutTab = get_CharOutTab(C,StringType),
- %% NunBits and CharOutTab for chars_encode
- emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value).
-
-emit_enc_k_m_string(0, _NumBits, _CharOutTab, _Value) ->
- emit({"[]"});
-emit_enc_k_m_string(SizeC, NumBits, CharOutTab, Value) ->
- call(per, encode_known_multiplier_string,
- [{asis,SizeC},NumBits,{asis,CharOutTab},Value]).
-
-
-%% copied from run time module
-
-get_CharOutTab(C, StringType) ->
- case get_constraint(C,'PermittedAlphabet') of
- {'SingleValue',Sv} ->
- get_CharTab2(C, StringType, hd(Sv), lists:max(Sv), Sv);
- no ->
- case StringType of
- 'IA5String' ->
- {0,16#7F,notab};
- 'VisibleString' ->
- get_CharTab2(C, StringType, 16#20, 16#7F, notab);
- 'PrintableString' ->
- Chars = lists:sort(
- " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"),
- get_CharTab2(C, StringType, hd(Chars),
- lists:max(Chars), Chars);
- 'NumericString' ->
- get_CharTab2(C, StringType, 16#20, $9, " 0123456789");
- 'UniversalString' ->
- {0,16#FFFFFFFF,notab};
- 'BMPString' ->
- {0,16#FFFF,notab}
- end
- end.
-
-get_CharTab2(C, StringType, Min, Max, Chars) ->
- BitValMax = (1 bsl get_NumBits(C,StringType))-1,
- if
- Max =< BitValMax ->
- {0,Max,notab};
- true ->
- {Min,Max,create_char_tab(Min,Chars)}
- end.
-
-create_char_tab(Min,L) ->
- list_to_tuple(create_char_tab(Min,L,0)).
-create_char_tab(Min,[Min|T],V) ->
- [V|create_char_tab(Min+1,T,V+1)];
-create_char_tab(_Min,[],_V) ->
- [];
-create_char_tab(Min,L,V) ->
- [false|create_char_tab(Min+1,L,V)].
-
-get_NumBits(C,StringType) ->
- case get_constraint(C,'PermittedAlphabet') of
- {'SingleValue',Sv} ->
- charbits(length(Sv),aligned);
- no ->
- case StringType of
- 'IA5String' ->
- charbits(128,aligned); % 16#00..16#7F
- 'VisibleString' ->
- charbits(95,aligned); % 16#20..16#7E
- 'PrintableString' ->
- charbits(74,aligned); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z
- 'NumericString' ->
- charbits(11,aligned); % $ ,"0123456789"
- 'UniversalString' ->
- 32;
- 'BMPString' ->
- 16
- end
- end.
-
-charbits(NumOfChars,aligned) ->
- case charbits(NumOfChars) of
- 1 -> 1;
- 2 -> 2;
- B when B =< 4 -> 4;
- B when B =< 8 -> 8;
- B when B =< 16 -> 16;
- B when B =< 32 -> 32
- end.
-
-charbits(NumOfChars) when NumOfChars =< 2 -> 1;
-charbits(NumOfChars) when NumOfChars =< 4 -> 2;
-charbits(NumOfChars) when NumOfChars =< 8 -> 3;
-charbits(NumOfChars) when NumOfChars =< 16 -> 4;
-charbits(NumOfChars) when NumOfChars =< 32 -> 5;
-charbits(NumOfChars) when NumOfChars =< 64 -> 6;
-charbits(NumOfChars) when NumOfChars =< 128 -> 7;
-charbits(NumOfChars) when NumOfChars =< 256 -> 8;
-charbits(NumOfChars) when NumOfChars =< 512 -> 9;
-charbits(NumOfChars) when NumOfChars =< 1024 -> 10;
-charbits(NumOfChars) when NumOfChars =< 2048 -> 11;
-charbits(NumOfChars) when NumOfChars =< 4096 -> 12;
-charbits(NumOfChars) when NumOfChars =< 8192 -> 13;
-charbits(NumOfChars) when NumOfChars =< 16384 -> 14;
-charbits(NumOfChars) when NumOfChars =< 32768 -> 15;
-charbits(NumOfChars) when NumOfChars =< 65536 -> 16;
-charbits(NumOfChars) when is_integer(NumOfChars) ->
- 16 + charbits1(NumOfChars bsr 16).
-
-charbits1(0) ->
- 0;
-charbits1(NumOfChars) ->
- 1 + charbits1(NumOfChars bsr 1).
-
-%% copied from run time module
-
-emit_enc_octet_string(Erules, Constraint, Value) ->
- case effective_constraint(bitstring, Constraint) of
- 0 ->
- emit({" []"});
- 1 ->
- asn1ct_name:new(tmpval),
- emit({" begin",nl}),
- emit({" [",{curr,tmpval},"] = ",Value,",",nl}),
- emit([" [[10,8],",{curr,tmpval},"]",nl]),
- emit(" end");
- 2 ->
- asn1ct_name:new(tmpval),
- emit([" begin",nl,
- " ",{curr,tmpval}," = ",Value,",",nl,
- " case length(",{curr,tmpval},") of",nl,
- " 2 ->",nl,
- " [[45,16,2]|",{curr,tmpval},"];",nl,
- " _ ->",nl,
- " exit({error,{value_out_of_bounds,",
- {curr,tmpval},"}})",nl,
- " end",nl,
- " end"]);
- Sv when is_integer(Sv), Sv < 256 ->
- asn1ct_name:new(tmpval),
- asn1ct_name:new(tmplen),
- emit([" begin",nl,
- " ",{curr,tmpval}," = ",Value,",",nl,
- " case length(",{curr,tmpval},") of",nl,
- " ",Sv,"=",{curr,tmplen}," ->",nl,
- " [20,",{curr,tmplen},"|",{curr,tmpval},"];",nl,
- " _ ->",nl,
- " exit({error,{value_out_of_bounds,",
- {curr,tmpval},"}})",nl,
- " end",nl,
- " end"]);
- Sv when is_integer(Sv),Sv =< 65535 ->
- asn1ct_name:new(tmpval),
- asn1ct_name:new(tmplen),
- emit([" begin",nl,
- " ",{curr,tmpval}," = ",Value,",",nl,
- " case length(",{curr,tmpval},") of",nl,
- " ",Sv,"=",{curr,tmplen}," ->",nl,
- " [<<21,",{curr,tmplen},":16>>|",Value,"];",nl,
- " _ ->",nl,
- " exit({error,{value_out_of_bounds,",
- {curr,tmpval},"}})",nl,
- " end",nl,
- " end"]);
- C ->
- call(Erules, encode_octet_string,
- [{asis,C},Value])
- end.
-
-emit_enc_integer_case(Value) ->
- case get(component_type) of
- {true,#'ComponentType'{prop=Prop}} ->
- emit({" begin",nl}),
- case Prop of
- Opt when Opt=='OPTIONAL';
- is_tuple(Opt),element(1,Opt)=='DEFAULT' ->
- emit({" case ",Value," of",nl}),
- ok;
- _ ->
- emit({" ",{curr,tmpval},"=",Value,",",nl}),
- emit({" case ",{curr,tmpval}," of",nl}),
- asn1ct_name:new(tmpval)
- end;
-% asn1ct_name:new(tmpval);
- _ ->
- emit({" case ",Value," of ",nl})
- end.
-emit_enc_integer_end_case() ->
- case get(component_type) of
- {true,_} ->
- emit({nl," end"}); % end of begin ... end
- _ -> ok
- end.
-
-
-emit_enc_integer_NNL(Erules,C,Value,NNL) ->
- EncVal = enc_integer_NNL_cases(Value,NNL),
- emit_enc_integer(Erules,C,EncVal).
-
-enc_integer_NNL_cases(Value,NNL) ->
- asn1ct_name:new(tmpval),
- TmpVal = asn1ct_gen:mk_var(asn1ct_name:curr(tmpval)),
- Cases=enc_integer_NNL_cases1(NNL),
- lists:flatten(io_lib:format("(case ~s of "++Cases++
- "~s when is_atom(~s)->exit({error,{asn1,{namednumber,~s}}});_->~s end)",[Value,TmpVal,TmpVal,TmpVal,Value])).
-
-enc_integer_NNL_cases1([{NNo,No}|Rest]) ->
- io_lib:format("~w->~w;",[NNo,No])++enc_integer_NNL_cases1(Rest);
-enc_integer_NNL_cases1([]) ->
- "".
-
-emit_enc_integer(_Erule,[{'SingleValue',Int}],Value) ->
- asn1ct_name:new(tmpval),
- emit_enc_integer_case(Value),% emit([" case ",Value," of",nl]),
- emit([" ",Int," -> [];",nl]),
- emit([" ",{curr,tmpval}," ->",nl]),
- emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})",
- nl," end",nl]),
- emit_enc_integer_end_case();
-
-emit_enc_integer(_Erule,[{_,{Lb,Ub},_Range,{bits,NoBs}}],Value) -> % Range =< 255
- asn1ct_name:new(tmpval),
- emit_enc_integer_case(Value),
- emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",",
- {curr,tmpval},">=",Lb," ->",nl]),
- emit([" [10,",NoBs,",",{curr,tmpval},"- ",Lb,"];",nl]),
- emit([" ",{curr,tmpval}," ->",nl]),
- emit([" exit({error,{value_out_of_bounds,",
- {curr,tmpval},"}})",nl," end",nl]),
- emit_enc_integer_end_case();
-
-emit_enc_integer(_Erule,[{_,{Lb,Ub},Range,_}],Value) when Range =< 256 ->
- asn1ct_name:new(tmpval),
- emit_enc_integer_case(Value),
- emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",",
- {curr,tmpval},">=",Lb," ->",nl]),
- emit([" [20,1,",{curr,tmpval},"- ",Lb,"];",nl]),
- emit([" ",{curr,tmpval}," ->",nl]),
- emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})",
- nl," end",nl]),
- emit_enc_integer_end_case();
-
-emit_enc_integer(_Erule,[{_,{Lb,Ub},Range,_}],Value) when Range =< 65536 ->
- asn1ct_name:new(tmpval),
- emit_enc_integer_case(Value),
- emit([" ",{curr,tmpval}," when ",{curr,tmpval},"=<",Ub,",",
- {curr,tmpval},">=",Lb," ->",nl]),
- emit([" [20,2,<<(",{curr,tmpval},"- ",Lb,"):16>>];",nl]),
- emit([" ",{curr,tmpval}," ->",nl]),
- emit([" exit({error,{value_out_of_bounds,",{curr,tmpval},"}})",
- nl," end",nl]),
- emit_enc_integer_end_case();
-
-emit_enc_integer(Erule, [{'ValueRange',{Lb,Ub}=VR}], Value)
- when is_integer(Lb), is_integer(Ub) ->
- call(Erule, encode_constrained_number, [{asis,VR},Value]);
-
-emit_enc_integer(Erule, C, Value) ->
- call(Erule, encode_integer, [{asis,C},Value]).
-
-
-get_constraint([{Key,V}],Key) ->
- V;
-get_constraint([],_) ->
- no;
-get_constraint(C,Key) ->
- case lists:keysearch(Key,1,C) of
- false ->
- no;
- {value,{_,V}} ->
- V
- end.
-
-%% effective_constraint(Type,C)
-%% Type = atom()
-%% C = [C1,...]
-%% C1 = {'SingleValue',SV} | {'ValueRange',VR} | {atom(),term()}
-%% SV = integer() | [integer(),...]
-%% VR = {Lb,Ub}
-%% Lb = 'MIN' | integer()
-%% Ub = 'MAX' | integer()
-%% Returns a single value if C only has a single value constraint, and no
-%% value range constraints, that constrains to a single value, otherwise
-%% returns a value range that has the lower bound set to the lowest value
-%% of all single values and lower bound values in C and the upper bound to
-%% the greatest value.
-effective_constraint(integer,[C={{_,_},_}|_Rest]) -> % extension
- [C]; %% [C|effective_constraint(integer,Rest)]; XXX what is possible ???
-effective_constraint(integer,C) ->
- pre_encode(integer, asn1ct_imm:effective_constraint(integer, C));
-effective_constraint(bitstring,C) ->
- asn1ct_imm:effective_constraint(bitstring, C).
-
-pre_encode(integer,[]) ->
- [];
-pre_encode(integer,C=[{'SingleValue',_}]) ->
- C;
-pre_encode(integer,C=[{'ValueRange',VR={Lb,Ub}}]) when is_integer(Lb),is_integer(Ub)->
- Range = Ub-Lb+1,
- if
- Range =< 255 ->
- NoBits = no_bits(Range),
- [{'ValueRange',VR,Range,{bits,NoBits}}];
- Range =< 256 ->
- [{'ValueRange',VR,Range,{octets,1}}];
- Range =< 65536 ->
- [{'ValueRange',VR,Range,{octets,2}}];
- true ->
- C
- end;
-pre_encode(integer,C) ->
- C.
-
-no_bits(2) -> 1;
-no_bits(N) when N=<4 -> 2;
-no_bits(N) when N=<8 -> 3;
-no_bits(N) when N=<16 -> 4;
-no_bits(N) when N=<32 -> 5;
-no_bits(N) when N=<64 -> 6;
-no_bits(N) when N=<128 -> 7;
-no_bits(N) when N=<255 -> 8.
diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl
index bf362db843..892178f61b 100644
--- a/lib/asn1/src/asn1ct_imm.erl
+++ b/lib/asn1/src/asn1ct_imm.erl
@@ -26,6 +26,18 @@
per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1,
per_dec_restricted_string/1]).
-export([per_dec_constrained/3,per_dec_normally_small_number/1]).
+-export([per_enc_bit_string/4,per_enc_boolean/2,
+ per_enc_choice/3,per_enc_enumerated/3,
+ per_enc_integer/3,per_enc_integer/4,
+ per_enc_null/2,
+ per_enc_k_m_string/4,per_enc_octet_string/3,
+ per_enc_open_type/2,
+ per_enc_restricted_string/3,
+ per_enc_small_number/2]).
+-export([per_enc_extension_bit/2,per_enc_extensions/4,per_enc_optional/3]).
+-export([per_enc_sof/5]).
+-export([enc_absent/3,enc_append/1,enc_bind_var/1]).
+-export([enc_cg/2]).
-export([optimize_alignment/1,optimize_alignment/2,
dec_slim_cg/2,dec_code_gen/2]).
-export([effective_constraint/2]).
@@ -115,29 +127,18 @@ per_dec_named_integer(Constraint, NamedList0, Aligned) ->
per_dec_k_m_string(StringType, Constraint, Aligned) ->
SzConstr = effective_constraint(bitstring, Constraint),
N = string_num_bits(StringType, Constraint, Aligned),
- %% X.691 (07/2002) 27.5.7 says if the upper bound times the number
- %% of bits is greater than or equal to 16, then the bit field should
- %% be aligned.
- Imm = dec_string(SzConstr, N, Aligned, fun(_, Ub) -> Ub >= 16 end),
+ Imm = dec_string(SzConstr, N, Aligned, k_m_string),
Chars = char_tab(Constraint, StringType, N),
convert_string(N, Chars, Imm).
per_dec_octet_string(Constraint, Aligned) ->
- dec_string(Constraint, 8, Aligned,
- %% Aligned unless the size is fixed and =< 16.
- fun(Sv, Sv) -> Sv > 16;
- (_, _) -> true
- end).
+ dec_string(Constraint, 8, Aligned, 'OCTET STRING').
per_dec_raw_bitstring(Constraint, Aligned) ->
- dec_string(Constraint, 1, Aligned,
- fun(Sv, Sv) -> Sv > 16;
- (_, _) -> true
- end).
+ dec_string(Constraint, 1, Aligned, 'BIT STRING').
per_dec_open_type(Aligned) ->
- {get_bits,decode_unconstrained_length(true, Aligned),
- [8,binary,{align,Aligned}]}.
+ dec_string(no, 8, Aligned, open_type).
per_dec_real(Aligned) ->
Dec = fun(V, Buf) ->
@@ -152,26 +153,285 @@ per_dec_restricted_string(Aligned) ->
DecLen = decode_unconstrained_length(true, Aligned),
{get_bits,DecLen,[8,binary]}.
+%%%
+%%% Encoding.
+%%%
+
+per_enc_bit_string(Val0, [], Constraint0, Aligned) ->
+ {B,[Val,Bs,Bits]} = mk_vars(Val0, [bs,bits]),
+ Constraint = effective_constraint(bitstring, Constraint0),
+ ExtraArgs = case constr_min_size(Constraint) of
+ no -> [];
+ Lb -> [Lb]
+ end,
+ B ++ [{call,per_common,to_bitstring,[Val|ExtraArgs],Bs},
+ {call,erlang,bit_size,[Bs],Bits}|
+ per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')];
+per_enc_bit_string(Val0, NNL0, Constraint0, Aligned) ->
+ {B,[Val,Bs,Bits,Positions]} = mk_vars(Val0, [bs,bits,positions]),
+ NNL = lists:keysort(2, NNL0),
+ Constraint = effective_constraint(bitstring, Constraint0),
+ ExtraArgs = case constr_min_size(Constraint) of
+ no -> [];
+ Lb -> [Lb]
+ end,
+ B ++ [{'try',
+ [bit_string_name2pos_fun(NNL, Val)],
+ {Positions,
+ [{call,per_common,bitstring_from_positions,
+ [Positions|ExtraArgs]}]},
+ [{call,per_common,to_named_bitstring,[Val|ExtraArgs]}],Bs},
+ {call,erlang,bit_size,[Bs],Bits}|
+ per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')].
+
+per_enc_boolean(Val0, _Aligned) ->
+ {B,[Val]} = mk_vars(Val0, []),
+ B++build_cond([[{eq,Val,false},{put_bits,0,1,[1]}],
+ [{eq,Val,true},{put_bits,1,1,[1]}]]).
+
+per_enc_choice(Val0, Cs0, _Aligned) ->
+ {B,[Val]} = mk_vars(Val0, []),
+ Cs = [[{eq,Val,Tag}|opt_choice(Imm)] || {Tag,Imm} <- Cs0],
+ B++build_cond(Cs).
+
+per_enc_enumerated(Val0, {Root,Ext}, Aligned) ->
+ {B,[Val]} = mk_vars(Val0, []),
+ Constr = enumerated_constraint(Root),
+ RootCs = per_enc_enumerated_root(Root, [{put_bits,0,1,[1]}],
+ Val, Constr, Aligned),
+ ExtCs = per_enc_enumerated_ext(Ext, Val, Aligned),
+ B++[{'cond',RootCs++ExtCs++enumerated_error(Val)}];
+per_enc_enumerated(Val0, Root, Aligned) ->
+ {B,[Val]} = mk_vars(Val0, []),
+ Constr = enumerated_constraint(Root),
+ Cs = per_enc_enumerated_root(Root, [], Val, Constr, Aligned),
+ B++[{'cond',Cs++enumerated_error(Val)}].
+
+enumerated_error(Val) ->
+ [['_',{error,Val}]].
+
+per_enc_integer(Val0, Constraint0, Aligned) ->
+ {B,[Val]} = mk_vars(Val0, []),
+ Constraint = effective_constraint(integer, Constraint0),
+ B ++ per_enc_integer_1(Val, Constraint, Aligned).
+
+per_enc_integer(Val0, NNL, Constraint0, Aligned) ->
+ {B,[Val]} = mk_vars(Val0, []),
+ Constraint = effective_constraint(integer, Constraint0),
+ Cs = [[{eq,Val,N}|per_enc_integer_1(V, Constraint, Aligned)] ||
+ {N,V} <- NNL],
+ case per_enc_integer_1(Val, Constraint, Aligned) of
+ [{'cond',IntCs}] ->
+ B ++ [{'cond',Cs++IntCs}];
+ Other ->
+ B ++ [{'cond',Cs++[['_'|Other]]}]
+ end.
+
+per_enc_null(_Val, _Aligned) ->
+ [].
+
+per_enc_k_m_string(Val0, StringType, Constraint, Aligned) ->
+ {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]),
+ SzConstraint = effective_constraint(bitstring, Constraint),
+ Unit = string_num_bits(StringType, Constraint, Aligned),
+ Chars0 = char_tab(Constraint, StringType, Unit),
+ Args = case enc_char_tab(Chars0) of
+ notab -> [Val,Unit];
+ Chars -> [Val,Unit,Chars]
+ end,
+ Enc = case Unit of
+ 16 ->
+ {call,per_common,encode_chars_16bit,[Val],Bin};
+ 32 ->
+ {call,per_common,encode_big_chars,[Val],Bin};
+ 8 ->
+ {call,erlang,list_to_binary,[Val],Bin};
+ _ ->
+ {call,per_common,encode_chars,Args,Bin}
+ end,
+ case Unit of
+ 8 ->
+ B ++ [Enc,{call,erlang,byte_size,[Bin],Len}];
+ _ ->
+ B ++ [{call,erlang,length,[Val],Len},Enc]
+ end ++ per_enc_length(Bin, Unit, Len, SzConstraint, Aligned, k_m_string).
+
+per_enc_open_type([], Aligned) ->
+ [{put_bits,1,8,unit(1, Aligned)},{put_bits,0,8,[1]}];
+per_enc_open_type([{'cond',
+ [['_',
+ {put_bits,0,0,_},
+ {call,per_common,encode_unconstrained_number,_}=Call]]}],
+ Aligned) ->
+ %% We KNOW that encode_unconstrained_number/1 will return an IO list;
+ %% therefore the call to complete/1 can be replaced with a cheaper
+ %% call to iolist_to_binary/1.
+ {Dst,Imm} = per_enc_open_type_output([Call], []),
+ ToBin = {erlang,iolist_to_binary},
+ Imm ++ per_enc_open_type(Dst, ToBin, Aligned);
+per_enc_open_type([{call,erlang,iolist_to_binary,Args}], Aligned) ->
+ {_,[_,Bin,Len]} = mk_vars('dummy', [bin,len]),
+ [{call,erlang,iolist_to_binary,Args,Bin},
+ {call,erlang,byte_size,[Bin],Len}|per_enc_length(Bin, 8, Len, Aligned)];
+per_enc_open_type(Imm0, Aligned) ->
+ try
+ {Prefix,Imm1} = split_off_nonbuilding(Imm0),
+ Prefix ++ enc_open_type(Imm1, Aligned)
+ catch
+ throw:impossible ->
+ {Dst,Imm} = per_enc_open_type_output(Imm0, []),
+ ToBin = {enc_mod(Aligned),complete},
+ Imm ++ per_enc_open_type(Dst, ToBin, Aligned)
+ end.
+
+per_enc_octet_string(Val0, Constraint0, Aligned) ->
+ {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]),
+ Constraint = effective_constraint(bitstring, Constraint0),
+ B ++ [{call,erlang,iolist_to_binary,[Val],Bin},
+ {call,erlang,byte_size,[Bin],Len}|
+ per_enc_length(Bin, 8, Len, Constraint, Aligned, 'OCTET STRING')].
+
+per_enc_restricted_string(Val0, {M,F}, Aligned) ->
+ {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]),
+ B ++ [{call,M,F,[Val],Bin},
+ {call,erlang,byte_size,[Bin],Len}|
+ per_enc_length(Bin, 8, Len, Aligned)].
+
+per_enc_small_number(Val, Aligned) ->
+ build_cond([[{lt,Val,64},{put_bits,Val,7,[1]}],
+ ['_',{put_bits,1,1,[1]}|
+ per_enc_unsigned(Val, Aligned)]]).
+
+per_enc_extension_bit(Val0, _Aligned) ->
+ {B,[Val]} = mk_vars(Val0, []),
+ B++build_cond([[{eq,Val,[]},{put_bits,0,1,[1]}],
+ ['_',{put_bits,1,1,[1]}]]).
+
+per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 ->
+ Pos = Pos0 + 1,
+ {B,[Val,Bitmap]} = mk_vars(Val0, [bitmap]),
+ Length = per_enc_small_length(NumBits, Aligned),
+ PutBits = case NumBits of
+ 1 -> [{put_bits,1,1,[1]}];
+ _ -> [{put_bits,Bitmap,NumBits,[1]}]
+ end,
+ B++[{call,per_common,extension_bitmap,[Val,Pos,Pos+NumBits],Bitmap},
+ {'cond',[[{eq,Bitmap,0}],
+ ['_'|Length ++ PutBits]],{var,"Extensions"}}].
+
+per_enc_optional(Val0, {Pos,Def}, _Aligned) when is_integer(Pos) ->
+ Val1 = lists:concat(["element(",Pos,", ",Val0,")"]),
+ {B,[Val]} = mk_vars(Val1, []),
+ Zero = {put_bits,0,1,[1]},
+ One = {put_bits,1,1,[1]},
+ B++[{'cond',[[{eq,Val,asn1_DEFAULT},Zero],
+ [{eq,Val,Def},Zero],
+ ['_',One]]}];
+per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) ->
+ Val1 = lists:concat(["element(",Pos,", ",Val0,")"]),
+ {B,[Val]} = mk_vars(Val1, []),
+ Zero = {put_bits,0,1,[1]},
+ One = {put_bits,1,1,[1]},
+ B++[{'cond',[[{eq,Val,asn1_NOVALUE},Zero],
+ ['_',One]]}].
+
+per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) ->
+ {B,[Val,Len]} = mk_vars(Val0, [len]),
+ SzConstraint = effective_constraint(bitstring, Constraint),
+ LenImm = enc_length(Len, SzConstraint, Aligned),
+ Lc0 = [{lc,ElementImm,{var,atom_to_list(ElementVar)},Val}],
+ Lc = opt_lc(Lc0, LenImm),
+ PreBlock = B ++ [{call,erlang,length,[Val],Len}],
+ case LenImm of
+ [{'cond',[[C|Action]]}] ->
+ PreBlock ++ [{'cond',[[C|Action++Lc]]}];
+ [{sub,_,_,_}=Sub,{'cond',[[C|Action]]}] ->
+ PreBlock ++
+ [Sub,{'cond',[[C|Action++Lc]]}];
+ EncLen ->
+ PreBlock ++ EncLen ++ Lc
+ end.
+
+enc_absent(Val0, AbsVals, Body) ->
+ {B,[Var]} = mk_vars(Val0, []),
+ Cs = [[{eq,Var,Aval}] || Aval <- AbsVals] ++ [['_'|Body]],
+ B++build_cond(Cs).
+
+enc_append([[]|T]) ->
+ enc_append(T);
+enc_append([[{put_bits,_,_,_}|_]=Pb|[Imm|T]=T0]) ->
+ case opt_choice(Pb++Imm) of
+ [{put_bits,_,_,_}|_] ->
+ [{block,Pb}|enc_append(T0)];
+ Opt ->
+ enc_append([Opt|T])
+ end;
+enc_append([Imm0|[Imm1|T]=T0]) ->
+ try combine_imms(Imm0, Imm1) of
+ Imm ->
+ enc_append([Imm|T])
+ catch
+ throw:impossible ->
+ [{block,Imm0}|enc_append(T0)]
+ end;
+enc_append([H|T]) ->
+ [{block,H}|enc_append(T)];
+enc_append([]) -> [].
+
+enc_bind_var(Val) ->
+ {B,[{var,Var}]} = mk_vars(Val, []),
+ {B,list_to_atom(Var)}.
+
+enc_cg(Imm0, false) ->
+ Imm1 = enc_cse(Imm0),
+ Imm = enc_pre_cg(Imm1),
+ enc_cg(Imm);
+enc_cg(Imm0, true) ->
+ Imm1 = enc_cse(Imm0),
+ Imm2 = enc_hoist_align(Imm1),
+ Imm3 = enc_opt_al(Imm2),
+ Imm4 = per_fixup(Imm3),
+ Imm = enc_pre_cg(Imm4),
+ enc_cg(Imm).
%%%
%%% Local functions.
%%%
-dec_string(Sv, U, Aligned0, AF) when is_integer(Sv) ->
+%% is_aligned(StringType, LowerBound, UpperBound) -> boolean()
+%% StringType = 'OCTET STRING' | 'BIT STRING' | k_m_string
+%% LowerBound = UpperBound = number of bits
+%% Determine whether a string should be aligned in PER.
+
+is_aligned(T, Lb, Ub) when T =:= 'OCTET STRING'; T =:= 'BIT STRING' ->
+ %% OCTET STRINGs and BIT STRINGs are aligned to a byte boundary
+ %% unless the size is fixed and less than or equal to 16 bits.
+ Lb =/= Ub orelse Lb > 16;
+is_aligned(k_m_string, _Lb, Ub) ->
+ %% X.691 (07/2002) 27.5.7 says if the upper bound times the number
+ %% of bits is greater than or equal to 16, then the bit field should
+ %% be aligned.
+ Ub >= 16.
+
+%%%
+%%% Generating the intermediate format format for decoding.
+%%%
+
+dec_string(Sv, U, Aligned0, T) when is_integer(Sv) ->
Bits = U*Sv,
- Aligned = Aligned0 andalso AF(Bits, Bits),
+ Aligned = Aligned0 andalso is_aligned(T, Bits, Bits),
{get_bits,Sv,[U,binary,{align,Aligned}]};
-dec_string({{Sv,Sv},[]}, U, Aligned, AF) ->
- bit_case(dec_string(Sv, U, Aligned, AF),
- dec_string(no, U, Aligned, AF));
-dec_string({{_,_}=C,[]}, U, Aligned, AF) ->
- bit_case(dec_string(C, U, Aligned, AF),
- dec_string(no, U, Aligned, AF));
-dec_string({Lb,Ub}, U, Aligned0, AF) ->
+dec_string({{Sv,Sv},[]}, U, Aligned, T) ->
+ bit_case(dec_string(Sv, U, Aligned, T),
+ dec_string(no, U, Aligned, T));
+dec_string({{_,_}=C,[]}, U, Aligned, T) ->
+ bit_case(dec_string(C, U, Aligned, T),
+ dec_string(no, U, Aligned, T));
+dec_string({Lb,Ub}, U, Aligned0, T) ->
Len = per_dec_constrained(Lb, Ub, Aligned0),
- Aligned = Aligned0 andalso AF(Lb*U, Ub*U),
+ Aligned = Aligned0 andalso is_aligned(T, Lb*U, Ub*U),
{get_bits,Len,[U,binary,{align,Aligned}]};
-dec_string(_, U, Aligned, _AF) ->
+dec_string(_, U, Aligned, _T) ->
Al = [{align,Aligned}],
DecRest = fun(V, Buf) ->
asn1ct_func:call(per_common,
@@ -692,6 +952,1164 @@ mk_dest(I) when is_integer(I) ->
integer_to_list(I);
mk_dest(S) -> S.
+%%%
+%%% Constructing the intermediate format for encoding.
+%%%
+
+split_off_nonbuilding(Imm) ->
+ lists:splitwith(fun is_nonbuilding/1, Imm).
+
+is_nonbuilding({apply,_,_,_}) -> true;
+is_nonbuilding({assign,_,_}) -> true;
+is_nonbuilding({call,_,_,_,_}) -> true;
+is_nonbuilding({'cond',_,_}) -> true;
+is_nonbuilding({lc,_,_,_,_}) -> true;
+is_nonbuilding({sub,_,_,_}) -> true;
+is_nonbuilding({'try',_,_,_,_}) -> true;
+is_nonbuilding(_) -> false.
+
+mk_vars(Input0, Temps) ->
+ asn1ct_name:new(enc),
+ Curr = asn1ct_name:curr(enc),
+ [H|T] = atom_to_list(Curr),
+ Base = [H - ($a - $A)|T ++ "@"],
+ if
+ is_atom(Input0) ->
+ Input = {var,atom_to_list(Input0)},
+ {[],[Input|mk_vars_1(Base, Temps)]};
+ is_integer(Input0) ->
+ {[],[Input0|mk_vars_1(Base, Temps)]};
+ Input0 =:= [] ->
+ {[],[Input0|mk_vars_1(Base, Temps)]};
+ true ->
+ Input = mk_var(Base, input),
+ {[{assign,Input,Input0}],[Input|mk_vars_1(Base, Temps)]}
+ end.
+
+mk_vars_1(Base, Vars) ->
+ [mk_var(Base, V) || V <- Vars].
+
+mk_var(Base, V) ->
+ {var,Base ++ atom_to_list(V)}.
+
+per_enc_integer_1(Val, [], Aligned) ->
+ [{'cond',[['_'|per_enc_unconstrained(Val, Aligned)]]}];
+per_enc_integer_1(Val0, [{{_,_}=Constr,[]}], Aligned) ->
+ {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned),
+ Prefix++build_cond([[Check,{put_bits,0,1,[1]}|Action],
+ ['_',{put_bits,1,1,[1]}|
+ per_enc_unconstrained(Val0, Aligned)]]);
+per_enc_integer_1(Val0, [Constr], Aligned) ->
+ {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned),
+ Prefix++build_cond([[Check|Action],
+ ['_',{error,Val0}]]).
+
+per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) ->
+ per_enc_constrained(Val, Sv, Sv, Aligned);
+per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned)
+ when is_integer(Lb) ->
+ {Prefix,Val} = sub_lb(Val0, Lb),
+ {Prefix,{ge,Val,0},per_enc_unsigned(Val, Aligned)};
+per_enc_integer_2(Val, {'ValueRange',{Lb,Ub}}, Aligned)
+ when is_integer(Lb), is_integer(Ub) ->
+ per_enc_constrained(Val, Lb, Ub, Aligned).
+
+per_enc_constrained(Val, Sv, Sv, _Aligned) ->
+ {[],{eq,Val,Sv},[]};
+per_enc_constrained(Val0, Lb, Ub, false) ->
+ {Prefix,Val} = sub_lb(Val0, Lb),
+ Range = Ub - Lb + 1,
+ NumBits = uper_num_bits(Range),
+ Check = {ult,Val,Range},
+ Put = [{put_bits,Val,NumBits,[1]}],
+ {Prefix,Check,Put};
+per_enc_constrained(Val0, Lb, Ub, true) ->
+ {Prefix,Val} = sub_lb(Val0, Lb),
+ Range = Ub - Lb + 1,
+ if
+ Range < 256 ->
+ NumBits = per_num_bits(Range),
+ Check = {ult,Val,Range},
+ Put = [{put_bits,Val,NumBits,[1]}],
+ {Prefix,Check,Put};
+ Range =:= 256 ->
+ NumBits = 8,
+ Check = {ult,Val,Range},
+ Put = [{put_bits,Val,NumBits,[1,align]}],
+ {Prefix,Check,Put};
+ Range =< 65536 ->
+ Check = {ult,Val,Range},
+ Put = [{put_bits,Val,16,[1,align]}],
+ {Prefix,Check,Put};
+ true ->
+ {var,VarBase} = Val,
+ Bin = {var,VarBase++"@bin"},
+ BinSize0 = {var,VarBase++"@bin_size0"},
+ BinSize = {var,VarBase++"@bin_size"},
+ Check = {ult,Val,Range},
+ RangeOctsLen = byte_size(binary:encode_unsigned(Range - 1)),
+ BitsNeeded = per_num_bits(RangeOctsLen),
+ Enc = [{call,binary,encode_unsigned,[Val],Bin},
+ {call,erlang,byte_size,[Bin],BinSize0},
+ {sub,BinSize0,1,BinSize},
+ {'cond',[['_',
+ {put_bits,BinSize,BitsNeeded,[1]},
+ {put_bits,Bin,binary,[8,align]}]]}],
+ {Prefix,Check,Enc}
+ end.
+
+per_enc_unconstrained(Val, Aligned) ->
+ case Aligned of
+ false -> [];
+ true -> [{put_bits,0,0,[1,align]}]
+ end ++ [{call,per_common,encode_unconstrained_number,[Val]}].
+
+per_enc_unsigned(Val, Aligned) ->
+ case is_integer(Val) of
+ false ->
+ {var,VarBase} = Val,
+ Bin = {var,VarBase++"@bin"},
+ BinSize = {var,VarBase++"@bin_size"},
+ [{call,binary,encode_unsigned,[Val],Bin},
+ {call,erlang,byte_size,[Bin],BinSize}|
+ per_enc_length(Bin, 8, BinSize, Aligned)];
+ true ->
+ Bin = binary:encode_unsigned(Val),
+ Len = byte_size(Bin),
+ per_enc_length(Bin, 8, Len, Aligned)
+ end.
+
+%% Encode a length field without any constraint.
+per_enc_length(Bin, Unit, Len, Aligned) ->
+ U = unit(1, Aligned),
+ PutBits = put_bits_binary(Bin, Unit, Aligned),
+ EncFragmented = {call,per_common,encode_fragmented,[Bin,Unit]},
+ Al = case Aligned of
+ false -> [];
+ true -> [{put_bits,0,0,[1,align]}]
+ end,
+ build_cond([[{lt,Len,128},
+ {put_bits,Len,8,U},PutBits],
+ [{lt,Len,16384},
+ {put_bits,2,2,U},{put_bits,Len,14,[1]},PutBits],
+ ['_'|Al++[EncFragmented]]]).
+
+per_enc_length(Bin, Unit, Len, no, Aligned, _Type) ->
+ per_enc_length(Bin, Unit, Len, Aligned);
+per_enc_length(Bin, Unit, Len, {{Lb,Ub},[]}, Aligned, Type) ->
+ {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned),
+ NoExt = {put_bits,0,1,[1]},
+ U = unit(Unit, Aligned, Type, Lb*Unit, Ub*Unit),
+ PutBits = [{put_bits,Bin,binary,U}],
+ [{'cond',ExtConds0}] = per_enc_length(Bin, Unit, Len, Aligned),
+ Ext = {put_bits,1,1,[1]},
+ ExtConds = prepend_to_cond(ExtConds0, Ext),
+ build_length_cond(Prefix, [[Check,NoExt|PutLen++PutBits]|ExtConds]);
+per_enc_length(Bin, Unit, Len, {Lb,Ub}, Aligned, Type)
+ when is_integer(Lb) ->
+ {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned),
+ U = unit(Unit, Aligned, Type, Lb*Unit, Ub*Unit),
+ PutBits = [{put_bits,Bin,binary,U}],
+ build_length_cond(Prefix, [[Check|PutLen++PutBits]]);
+per_enc_length(Bin, Unit, Len, Sv, Aligned, Type) when is_integer(Sv) ->
+ NumBits = Sv*Unit,
+ U = unit(Unit, Aligned, Type, NumBits, NumBits),
+ Pb = {put_bits,Bin,binary,U},
+ [{'cond',[[{eq,Len,Sv},Pb]]}].
+
+enc_length(Len, no, Aligned) ->
+ U = unit(1, Aligned),
+ build_cond([[{lt,Len,128},
+ {put_bits,Len,8,U}],
+ [{lt,Len,16384},
+ {put_bits,2,2,U},{put_bits,Len,14,[1]}]]);
+enc_length(Len, {{Lb,Ub},[]}, Aligned) ->
+ {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned),
+ NoExt = {put_bits,0,1,[1]},
+ [{'cond',ExtConds0}] = enc_length(Len, no, Aligned),
+ Ext = {put_bits,1,1,[1]},
+ ExtConds = prepend_to_cond(ExtConds0, Ext),
+ build_length_cond(Prefix, [[Check,NoExt|PutLen]|ExtConds]);
+enc_length(Len, {Lb,Ub}, Aligned) when is_integer(Lb) ->
+ {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned),
+ build_length_cond(Prefix, [[Check|PutLen]]);
+enc_length(Len, Sv, _Aligned) when is_integer(Sv) ->
+ [{'cond',[[{eq,Len,Sv}]]}].
+
+put_bits_binary(Bin, _Unit, Aligned) when is_binary(Bin) ->
+ Sz = byte_size(Bin),
+ <<Int:Sz/unit:8>> = Bin,
+ {put_bits,Int,8*Sz,unit(1, Aligned)};
+put_bits_binary(Bin, Unit, Aligned) ->
+ {put_bits,Bin,binary,unit(Unit, Aligned)}.
+
+sub_lb(Val, 0) ->
+ {[],Val};
+sub_lb({var,Var}=Val0, Lb) ->
+ Val = {var,Var++"@sub"},
+ {[{sub,Val0,Lb,Val}],Val};
+sub_lb(Val, Lb) when is_integer(Val) ->
+ {[],Val-Lb}.
+
+build_length_cond([{sub,Var0,Base,Var}]=Prefix, Cs) ->
+ %% Non-zero lower bound, such as: SIZE (50..200, ...)
+ Prefix++[{'cond',opt_length_nzlb(Cs, {Var0,Var,Base}, 0)}];
+build_length_cond([], Cs) ->
+ %% Zero lower bound, such as: SIZE (0..200, ...)
+ [{'cond',opt_length_zlb(Cs, 0)}].
+
+opt_length_zlb([[{ult,Var,Val}|Actions]|T], Ub) ->
+ %% Since the SIZE constraint is zero-based, Var
+ %% must be greater than zero, and we can use
+ %% the slightly cheaper signed less than operator.
+ opt_length_zlb([[{lt,Var,Val}|Actions]|T], Ub);
+opt_length_zlb([[{lt,_,Val}|_]=H|T], Ub) ->
+ if
+ Val =< Ub ->
+ %% A previous test has already matched.
+ opt_length_zlb(T, Ub);
+ true ->
+ [H|opt_length_zlb(T, max(Ub, Val))]
+ end;
+opt_length_zlb([H|T], Ub) ->
+ [H|opt_length_zlb(T, Ub)];
+opt_length_zlb([], _) -> [].
+
+opt_length_nzlb([[{ult,Var,Val}|_]=H|T], {_,Var,Base}=St, _Ub) ->
+ [H|opt_length_nzlb(T, St, Base+Val)];
+opt_length_nzlb([[{lt,Var0,Val}|_]=H|T], {Var0,_,_}=St, Ub) ->
+ if
+ Val =< Ub ->
+ %% A previous test has already matched.
+ opt_length_nzlb(T, St, Ub);
+ true ->
+ [H|opt_length_nzlb(T, St, Val)]
+ end;
+opt_length_nzlb([H|T], St, Ub) ->
+ [H|opt_length_nzlb(T, St, Ub)];
+opt_length_nzlb([], _, _) -> [].
+
+build_cond(Conds0) ->
+ case eval_cond(Conds0, gb_sets:empty()) of
+ [['_'|Actions]] ->
+ Actions;
+ Conds ->
+ [{'cond',Conds}]
+ end.
+
+eval_cond([['_',{'cond',Cs}]], Seen) ->
+ eval_cond(Cs, Seen);
+eval_cond([[Cond|Actions]=H|T], Seen0) ->
+ case gb_sets:is_element(Cond, Seen0) of
+ false ->
+ Seen = gb_sets:insert(Cond, Seen0),
+ case eval_cond_1(Cond) of
+ false ->
+ eval_cond(T, Seen);
+ true ->
+ [['_'|Actions]];
+ maybe ->
+ [H|eval_cond(T, Seen)]
+ end;
+ true ->
+ eval_cond(T, Seen0)
+ end;
+eval_cond([], _) -> [].
+
+eval_cond_1({ult,I,N}) when is_integer(I), is_integer(N) ->
+ 0 =< I andalso I < N;
+eval_cond_1({eq,[],[]}) ->
+ true;
+eval_cond_1({eq,I,N}) when is_integer(I), is_integer(N) ->
+ I =:= N;
+eval_cond_1({lt,I,N}) when is_integer(I), is_integer(N) ->
+ I < N;
+eval_cond_1(_) -> maybe.
+
+prepend_to_cond([H|T], Code) ->
+ [prepend_to_cond_1(H, Code)|prepend_to_cond(T, Code)];
+prepend_to_cond([], _) -> [].
+
+prepend_to_cond_1([Check|T], Code) ->
+ [Check,Code|T].
+
+enc_char_tab(notab) ->
+ notab;
+enc_char_tab(Tab0) ->
+ Tab = tuple_to_list(Tab0),
+ First = hd(Tab),
+ {First-1,list_to_tuple(enc_char_tab_1(Tab, First, 0))}.
+
+enc_char_tab_1([H|T], H, I) ->
+ [I|enc_char_tab_1(T, H+1, I+1)];
+enc_char_tab_1([_|_]=T, H, I) ->
+ [ill|enc_char_tab_1(T, H+1, I)];
+enc_char_tab_1([], _, _) -> [].
+
+enumerated_constraint([_]) ->
+ [{'SingleValue',0}];
+enumerated_constraint(Root) ->
+ [{'ValueRange',{0,length(Root)-1}}].
+
+per_enc_enumerated_root(NNL, Prefix, Val, Constr, Aligned) ->
+ per_enc_enumerated_root_1(NNL, Prefix, Val, Constr, Aligned, 0).
+
+per_enc_enumerated_root_1([{H,_}|T], Prefix, Val, Constr, Aligned, N) ->
+ [[{eq,Val,H}|Prefix++per_enc_integer_1(N, Constr, Aligned)]|
+ per_enc_enumerated_root_1(T, Prefix, Val, Constr, Aligned, N+1)];
+per_enc_enumerated_root_1([], _, _, _, _, _) -> [].
+
+per_enc_enumerated_ext(NNL, Val, Aligned) ->
+ per_enc_enumerated_ext_1(NNL, Val, Aligned, 0).
+
+per_enc_enumerated_ext_1([{H,_}|T], Val, Aligned, N) ->
+ [[{eq,Val,H},{put_bits,1,1,[1]}|per_enc_small_number(N, Aligned)]|
+ per_enc_enumerated_ext_1(T, Val, Aligned, N+1)];
+per_enc_enumerated_ext_1([], _, _, _) -> [].
+
+per_enc_small_length(Val0, Aligned) ->
+ {Sub,Val} = sub_lb(Val0, 1),
+ U = unit(1, Aligned),
+ Sub ++ build_cond([[{lt,Val,64},{put_bits,Val,7,[1]}],
+ [{lt,Val0,128},{put_bits,1,1,[1]},
+ {put_bits,Val0,8,U}],
+ ['_',{put_bits,1,1,[1]},
+ {put_bits,2,2,U},{put_bits,Val0,14,[1]}]]).
+
+constr_min_size(no) -> no;
+constr_min_size({{Lb,_},[]}) when is_integer(Lb) -> Lb;
+constr_min_size({Lb,_}) when is_integer(Lb) -> Lb;
+constr_min_size(Sv) when is_integer(Sv) -> Sv.
+
+enc_mod(false) -> uper;
+enc_mod(true) -> per.
+
+unit(U, false) -> [U];
+unit(U, true) -> [U,align].
+
+unit(U, Aligned, Type, Lb, Ub) ->
+ case Aligned andalso is_aligned(Type, Lb, Ub) of
+ true -> [U,align];
+ false -> [U]
+ end.
+
+opt_choice(Imm) ->
+ {Pb,T0} = lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) ->
+ true;
+ (_) ->
+ false
+ end, Imm),
+ try
+ {Prefix,T} = split_off_nonbuilding(T0),
+ Prefix ++ opt_choice_1(T, Pb)
+ catch
+ throw:impossible ->
+ Imm
+ end.
+
+opt_choice_1([{'cond',Cs0}], Pb) ->
+ case Cs0 of
+ [[C|Act]] ->
+ [{'cond',[[C|Pb++Act]]}];
+ [[C|Act],['_',{error,_}]=Error] ->
+ [{'cond',[[C|Pb++Act],Error]}];
+ _ ->
+ [{'cond',opt_choice_2(Cs0, Pb)}]
+ end;
+opt_choice_1(_, _) -> throw(impossible).
+
+opt_choice_2([[C|[{put_bits,_,_,_}|_]=Act]|T], Pb) ->
+ [[C|Pb++Act]|opt_choice_2(T, Pb)];
+opt_choice_2([[_,{error,_}]=H|T], Pb) ->
+ [H|opt_choice_2(T, Pb)];
+opt_choice_2([_|_], _) ->
+ throw(impossible);
+opt_choice_2([], _) -> [].
+
+
+%%%
+%%% Helper functions for code generation of open types.
+%%%
+
+per_enc_open_type(Val0, {ToBinMod,ToBinFunc}, Aligned) ->
+ {B,[Val,Len,Bin]} = mk_vars(Val0, [len,bin]),
+ B ++ [{call,ToBinMod,ToBinFunc,[Val],Bin},
+ {call,erlang,byte_size,[Bin],Len}|
+ per_enc_length(Bin, 8, Len, Aligned)].
+
+enc_open_type([{'cond',Cs}], Aligned) ->
+ [{'cond',[[C|enc_open_type_1(Act, Aligned)] || [C|Act] <- Cs]}];
+enc_open_type(_, _) ->
+ throw(impossible).
+
+enc_open_type_1([{error,_}]=Imm, _) ->
+ Imm;
+enc_open_type_1(Imm, Aligned) ->
+ NumBits = num_bits(Imm, 0),
+ Pad = case 8 - (NumBits rem 8) of
+ 8 -> [];
+ Pad0 -> [{put_bits,0,Pad0,[1]}]
+ end,
+ NumBytes = (NumBits+7) div 8,
+ enc_length(NumBytes, no, Aligned) ++ Imm ++ Pad.
+
+num_bits([{put_bits,_,N,[U|_]}|T], Sum) when is_integer(N) ->
+ num_bits(T, Sum+N*U);
+num_bits([_|_], _) ->
+ throw(impossible);
+num_bits([], Sum) -> Sum.
+
+per_enc_open_type_output([{apply,F,A}], Acc) ->
+ Dst = output_var(),
+ {Dst,lists:reverse(Acc, [{apply,F,A,{var,atom_to_list(Dst)}}])};
+per_enc_open_type_output([{call,M,F,A}], Acc) ->
+ Dst = output_var(),
+ {Dst,lists:reverse(Acc, [{call,M,F,A,{var,atom_to_list(Dst)}}])};
+per_enc_open_type_output([{'cond',Cs}], Acc) ->
+ Dst = output_var(),
+ {Dst,lists:reverse(Acc, [{'cond',Cs,{var,atom_to_list(Dst)}}])};
+per_enc_open_type_output([H|T], Acc) ->
+ per_enc_open_type_output(T, [H|Acc]).
+
+output_var() ->
+ asn1ct_name:new(enc),
+ Curr = asn1ct_name:curr(enc),
+ [H|T] = atom_to_list(Curr),
+ list_to_atom([H - ($a - $A)|T ++ "@output"]).
+
+
+%%%
+%%% Optimize list comprehensions (SEQUENCE OF/SET OF).
+%%%
+
+opt_lc([{lc,[{call,erlang,iolist_to_binary,[Var],Bin},
+ {call,erlang,byte_size,[Bin],LenVar},
+ {'cond',[[{eq,LenVar,Len},{put_bits,Bin,_,[_|Align]}]]}],
+ Var,Val}]=Lc, LenImm) ->
+ %% Given a sequence of a fixed length string, such as
+ %% SEQUENCE OF OCTET STRING (SIZE (4)), attempt to rewrite to
+ %% a list comprehension that just checks the size, followed by
+ %% a conversion to binary:
+ %%
+ %% _ = [if length(Comp) =:= 4; byte_size(Comp) =:= 4 -> [] end ||
+ %% Comp <- Sof],
+ %% [align|iolist_to_binary(Sof)]
+
+ CheckImm = [{'cond',[[{eq,{expr,"length("++mk_val(Var)++")"},Len}],
+ [{eq,{expr,"byte_size("++mk_val(Var)++")"},Len}]]}],
+ Al = case Align of
+ [] ->
+ [];
+ [align] ->
+ [{put_bits,0,0,[1|Align]}]
+ end,
+ case Al =:= [] orelse
+ is_end_aligned(LenImm) orelse
+ lb_is_nonzero(LenImm) of
+ false ->
+ %% Not possible because an empty SEQUENCE OF would be
+ %% improperly aligned. Example:
+ %%
+ %% SEQUENCE (SIZE (0..3)) OF ...
+
+ Lc;
+ true ->
+ %% Examples:
+ %%
+ %% SEQUENCE (SIZE (1..4)) OF ...
+ %% (OK because there must be at least one element)
+ %%
+ %% SEQUENCE OF ...
+ %% (OK because the length field will force alignment)
+ %%
+ Al ++ [{lc,CheckImm,Var,Val,{var,"_"}},
+ {call,erlang,iolist_to_binary,[Val]}]
+ end;
+opt_lc([{lc,ElementImm0,V,L}]=Lc, LenImm) ->
+ %% Attempt to hoist the alignment, putting after the length
+ %% and before the list comprehension:
+ %%
+ %% [Length,
+ %% align,
+ %% [Encode(Comp) || Comp <- Sof]]
+ %%
+
+ case enc_opt_al_1(ElementImm0, 0) of
+ {ElementImm,0} ->
+ case is_end_aligned(LenImm) orelse
+ (is_beginning_aligned(ElementImm0) andalso
+ lb_is_nonzero(LenImm)) of
+ false ->
+ %% Examples:
+ %%
+ %% SEQUENCE (SIZE (0..3)) OF OCTET STRING
+ %% (An empty SEQUENCE OF would be improperly aligned)
+ %%
+ %% SEQUENCE (SIZE (1..3)) OF OCTET STRING (SIZE (0..4))
+ %% (There would be an improper alignment before the
+ %% first element)
+
+ Lc;
+ true ->
+ %% Examples:
+ %%
+ %% SEQUENCE OF INTEGER
+ %% SEQUENCE (SIZE (1..4)) OF INTEGER
+ %% SEQUENCE (SIZE (1..4)) OF INTEGER (0..256)
+
+ [{put_bits,0,0,[1,align]},{lc,ElementImm,V,L}]
+ end;
+ _ ->
+ %% Unknown alignment, no alignment, or not aligned at the end.
+ %% Examples:
+ %%
+ %% SEQUENCE OF SomeConstructedType
+ %% SEQUENCE OF INTEGER (0..15)
+
+ Lc
+ end.
+
+is_beginning_aligned([{'cond',Cs}]) ->
+ lists:all(fun([_|Act]) -> is_beginning_aligned(Act) end, Cs);
+is_beginning_aligned([{error,_}|_]) -> true;
+is_beginning_aligned([{put_bits,_,_,U}|_]) ->
+ case U of
+ [_,align] -> true;
+ [_] -> false
+ end;
+is_beginning_aligned(Imm0) ->
+ case split_off_nonbuilding(Imm0) of
+ {[],_} -> false;
+ {[_|_],Imm} -> is_beginning_aligned(Imm)
+ end.
+
+is_end_aligned(Imm) ->
+ case enc_opt_al_1(Imm, unknown) of
+ {_,0} -> true;
+ {_,_} -> false
+ end.
+
+lb_is_nonzero([{sub,_,_,_}|_]) -> true;
+lb_is_nonzero(_) -> false.
+
+%%%
+%%% Attempt to combine two chunks of intermediate code.
+%%%
+
+combine_imms(ImmA0, ImmB0) ->
+ {Prefix0,ImmA} = split_off_nonbuilding(ImmA0),
+ {Prefix1,ImmB} = split_off_nonbuilding(ImmB0),
+ Prefix = Prefix0 ++ Prefix1,
+ Combined = do_combine(ImmA ++ ImmB, 3.0),
+ Prefix ++ Combined.
+
+do_combine([{error,_}=Imm|_], _Budget) ->
+ [Imm];
+do_combine([{'cond',Cs0}|T], Budget0) ->
+ Budget = debit(Budget0, num_clauses(Cs0, 0)),
+ Cs = [[C|do_combine(Act++T, Budget)] || [C|Act] <- Cs0],
+ [{'cond',Cs}];
+do_combine([{put_bits,V,_,_}|_]=L, Budget) when is_integer(V) ->
+ {Pb,T} = collect_put_bits(L),
+ do_combine_put_bits(Pb, T,Budget);
+do_combine(_, _) ->
+ throw(impossible).
+
+do_combine_put_bits(Pb, [], _Budget) ->
+ Pb;
+do_combine_put_bits(Pb, [{'cond',Cs0}|T], Budget) ->
+ Cs = [case Act of
+ [{error,_}] ->
+ [C|Act];
+ _ ->
+ [C|do_combine(Pb++Act, Budget)]
+ end || [C|Act] <- Cs0],
+ do_combine([{'cond',Cs}|T], Budget);
+do_combine_put_bits(_, _, _) ->
+ throw(impossible).
+
+debit(Budget0, Alternatives) ->
+ case Budget0 - log2(Alternatives) of
+ Budget when Budget > 0.0 ->
+ Budget;
+ _ ->
+ throw(impossible)
+ end.
+
+num_clauses([[_,{error,_}]|T], N) ->
+ num_clauses(T, N);
+num_clauses([_|T], N) ->
+ num_clauses(T, N+1);
+num_clauses([], N) -> N.
+
+log2(N) ->
+ math:log(N) / math:log(2.0).
+
+collect_put_bits(Imm) ->
+ lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) -> true;
+ (_) -> false
+ end, Imm).
+
+%%%
+%%% Simple common subexpression elimination to avoid fetching
+%%% the same element twice.
+%%%
+
+enc_cse([{assign,{var,V},E}=H|T]) ->
+ [H|enc_cse_1(T, E, V)];
+enc_cse(Imm) -> Imm.
+
+enc_cse_1([{assign,Dst,E}|T], E, V) ->
+ [{assign,Dst,V}|enc_cse_1(T, E, V)];
+enc_cse_1([{block,Bl}|T], E, V) ->
+ [{block,enc_cse_1(Bl, E, V)}|enc_cse_1(T, E, V)];
+enc_cse_1([H|T], E, V) ->
+ [H|enc_cse_1(T, E, V)];
+enc_cse_1([], _, _) -> [].
+
+
+%%%
+%%% Pre-process the intermediate code to simplify code generation.
+%%%
+
+enc_pre_cg(Imm) ->
+ enc_pre_cg_1(Imm, outside_list, in_seq).
+
+enc_pre_cg_1([], _StL, _StB) ->
+ nil;
+enc_pre_cg_1([H], StL, StB) ->
+ enc_pre_cg_2(H, StL, StB);
+enc_pre_cg_1([H0|T0], StL, StB) ->
+ case is_nonbuilding(H0) of
+ true ->
+ H = enc_pre_cg_nonbuilding(H0, StL),
+ Seq = {seq,H,enc_pre_cg_1(T0, StL, in_seq)},
+ case StB of
+ outside_seq -> {block,Seq};
+ in_seq -> Seq
+ end;
+ false ->
+ H = enc_pre_cg_2(H0, in_head, outside_seq),
+ T = enc_pre_cg_1(T0, in_tail, outside_seq),
+ enc_make_cons(H, T)
+ end.
+
+enc_pre_cg_2(align, StL, _StB) ->
+ case StL of
+ in_head -> align;
+ in_tail -> {cons,align,nil}
+ end;
+enc_pre_cg_2({apply,_,_}=Imm, _, _) ->
+ Imm;
+enc_pre_cg_2({block,Bl0}, StL, StB) ->
+ enc_pre_cg_1(Bl0, StL, StB);
+enc_pre_cg_2({call,_,_,_}=Imm, _, _) ->
+ Imm;
+enc_pre_cg_2({call_gen,_,_,_,_}=Imm, _, _) ->
+ Imm;
+enc_pre_cg_2({'cond',Cs0}, StL, _StB) ->
+ Cs = [{C,enc_pre_cg_1(Act, StL, outside_seq)} || [C|Act] <- Cs0],
+ {'cond',Cs};
+enc_pre_cg_2({error,_}=E, _, _) ->
+ E;
+enc_pre_cg_2({lc,B0,V,L}, StL, _StB) ->
+ B = enc_pre_cg_1(B0, StL, outside_seq),
+ {lc,B,V,L};
+enc_pre_cg_2({put_bits,V,8,[1]}, StL, _StB) ->
+ case StL of
+ in_head -> {integer,V};
+ in_tail -> {cons,{integer,V},nil};
+ outside_list -> {cons,{integer,V},nil}
+ end;
+enc_pre_cg_2({put_bits,V,binary,_}, _StL, _StB) ->
+ V;
+enc_pre_cg_2({put_bits,_,_,[_]}=PutBits, _StL, _StB) ->
+ {binary,[PutBits]};
+enc_pre_cg_2({var,_}=Imm, _, _) -> Imm.
+
+enc_make_cons({binary,H}, {binary,T}) ->
+ {binary,H++T};
+enc_make_cons({binary,H0}, {cons,{binary,H1},T}) ->
+ {cons,{binary,H0++H1},T};
+enc_make_cons({integer,Int}, {binary,T}) ->
+ {binary,[{put_bits,Int,8,[1]}|T]};
+enc_make_cons(H, T) ->
+ {cons,H,T}.
+
+enc_pre_cg_nonbuilding({'cond',Cs0,Dst}, StL) ->
+ Cs = [{C,enc_pre_cg_1(Act, StL, outside_seq)} || [C|Act] <- Cs0],
+ {'cond',Cs,Dst};
+enc_pre_cg_nonbuilding({lc,B0,Var,List,Dst}, StL) ->
+ B = enc_pre_cg_1(B0, StL, outside_seq),
+ {lc,B,Var,List,Dst};
+enc_pre_cg_nonbuilding({'try',Try0,{P,Succ0},Else0,Dst}, StL) ->
+ Try = enc_pre_cg_1(Try0, StL, outside_seq),
+ Succ = enc_pre_cg_1(Succ0, StL, outside_seq),
+ Else = enc_pre_cg_1(Else0, StL, outside_seq),
+ {'try',Try,{P,Succ},Else,Dst};
+enc_pre_cg_nonbuilding(Imm, _) -> Imm.
+
+
+%%%
+%%% Code generation for encoding.
+%%%
+
+enc_cg({cons,_,_}=Cons) ->
+ enc_cg_cons(Cons);
+enc_cg({block,Imm}) ->
+ emit(["begin",nl]),
+ enc_cg(Imm),
+ emit([nl,
+ "end"]);
+enc_cg({seq,First,Then}) ->
+ enc_cg(First),
+ emit([com,nl]),
+ enc_cg(Then);
+enc_cg(align) ->
+ emit(align);
+enc_cg({apply,F0,As0}) ->
+ As = enc_call_args(As0, ""),
+ case F0 of
+ {M,F} ->
+ emit([{asis,M},":",{asis,F},"(",As,")"]);
+ F when is_atom(F) ->
+ emit([{asis,F},"(",As,")"])
+ end;
+enc_cg({apply,F0,As0,Dst}) ->
+ As = enc_call_args(As0, ""),
+ emit([mk_val(Dst)," = "]),
+ case F0 of
+ {M,F} ->
+ emit([{asis,M},":",{asis,F},"(",As,")"]);
+ F when is_atom(F) ->
+ emit([{asis,F},"(",As,")"])
+ end;
+enc_cg({assign,Dst0,Expr}) ->
+ Dst = mk_val(Dst0),
+ emit([Dst," = ",Expr]);
+enc_cg({binary,PutBits}) ->
+ emit(["<<",enc_cg_put_bits(PutBits, ""),">>"]);
+enc_cg({call,M,F,As0}) ->
+ As = [mk_val(A) || A <- As0],
+ asn1ct_func:call(M, F, As);
+enc_cg({call,M,F,As0,Dst}) ->
+ As = [mk_val(A) || A <- As0],
+ emit([mk_val(Dst)," = "]),
+ asn1ct_func:call(M, F, As);
+enc_cg({call_gen,Prefix,Key,Gen,As0}) ->
+ As = [mk_val(A) || A <- As0],
+ asn1ct_func:call_gen(Prefix, Key, Gen, As);
+enc_cg({'cond',Cs}) ->
+ enc_cg_cond(Cs);
+enc_cg({'cond',Cs,Dst0}) ->
+ Dst = mk_val(Dst0),
+ emit([Dst," = "]),
+ enc_cg_cond(Cs);
+enc_cg({error,Error}) when is_function(Error, 0) ->
+ Error();
+enc_cg({error,Var0}) ->
+ Var = mk_val(Var0),
+ emit(["exit({error,{asn1,{illegal_value,",Var,"}}})"]);
+enc_cg({integer,Int}) ->
+ emit(mk_val(Int));
+enc_cg({lc,Body,Var,List}) ->
+ emit("["),
+ enc_cg(Body),
+ emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]);
+enc_cg({lc,Body,Var,List,Dst}) ->
+ emit([mk_val(Dst)," = ["]),
+ enc_cg(Body),
+ emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]);
+enc_cg(nil) ->
+ emit("[]");
+enc_cg({sub,Src0,Int,Dst0}) ->
+ Src = mk_val(Src0),
+ Dst = mk_val(Dst0),
+ emit([Dst," = ",Src," - ",Int]);
+enc_cg({'try',Try,{P,Succ},Else,Dst}) ->
+ emit([mk_val(Dst)," = try "]),
+ enc_cg(Try),
+ emit([" of",nl,
+ mk_val(P)," ->",nl]),
+ enc_cg(Succ),
+ emit([nl,
+ "catch throw:invalid ->",nl]),
+ enc_cg(Else),
+ emit([nl,
+ "end"]);
+enc_cg({var,V}) ->
+ emit(V).
+
+enc_cg_cons(Cons) ->
+ emit("["),
+ enc_cg_cons_1(Cons),
+ emit("]").
+
+enc_cg_cons_1({cons,H,{cons,_,_}=T}) ->
+ enc_cg(H),
+ emit([com,nl]),
+ enc_cg_cons_1(T);
+enc_cg_cons_1({cons,H,nil}) ->
+ enc_cg(H);
+enc_cg_cons_1({cons,H,T}) ->
+ enc_cg(H),
+ emit("|"),
+ enc_cg(T).
+
+enc_call_args([A|As], Sep) ->
+ [Sep,mk_val(A)|enc_call_args(As, ", ")];
+enc_call_args([], _) -> [].
+
+enc_cg_cond([{'_',Action}]) ->
+ enc_cg(Action);
+enc_cg_cond(Cs) ->
+ emit("if "),
+ enc_cg_cond(Cs, ""),
+ emit([nl,
+ "end"]).
+
+enc_cg_cond([C|Cs], Sep) ->
+ emit(Sep),
+ enc_cg_cond_1(C),
+ enc_cg_cond(Cs, [";",nl]);
+enc_cg_cond([], _) -> ok.
+
+enc_cg_cond_1({Cond,Action}) ->
+ enc_cond_term(Cond),
+ emit([" ->",nl]),
+ enc_cg(Action).
+
+enc_cond_term('_') ->
+ emit("true");
+enc_cond_term({ult,Var0,Int}) ->
+ Var = mk_val(Var0),
+ N = uper_num_bits(Int),
+ case 1 bsl N of
+ Int ->
+ emit([Var," bsr ",N," =:= 0"]);
+ _ ->
+ emit(["0 =< ",Var,", ",Var," < ",Int])
+ end;
+enc_cond_term({eq,Var0,Term}) ->
+ Var = mk_val(Var0),
+ emit([Var," =:= ",{asis,Term}]);
+enc_cond_term({ge,Var0,Int}) ->
+ Var = mk_val(Var0),
+ emit([Var," >= ",Int]);
+enc_cond_term({lt,Var0,Int}) ->
+ Var = mk_val(Var0),
+ emit([Var," < ",Int]).
+
+enc_cg_put_bits([{put_bits,Val0,N,[1]}|T], Sep) ->
+ Val = mk_val(Val0),
+ [[Sep,Val,":",integer_to_list(N)]|enc_cg_put_bits(T, ",")];
+enc_cg_put_bits([], _) -> [].
+
+mk_val({var,Str}) -> Str;
+mk_val({expr,Str}) -> Str;
+mk_val(Int) when is_integer(Int) -> integer_to_list(Int);
+mk_val(Other) -> {asis,Other}.
+
+%%%
+%%% Generate a function that maps a name of a bit position
+%%% to the bit position.
+%%%
+
+bit_string_name2pos_fun(NNL, Src) ->
+ {call_gen,"bit_string_name2pos_",NNL,
+ fun(Fd, Name) -> gen_name2pos(Fd, Name, NNL) end,[Src]}.
+
+gen_name2pos(Fd, Name, Names) ->
+ Cs0 = gen_name2pos_cs(Names, Name),
+ Cs = Cs0 ++ [bit_clause(Name),nil_clause(),invalid_clause()],
+ F = {function,1,Name,1,Cs},
+ file:write(Fd, [erl_pp:function(F)]).
+
+gen_name2pos_cs([{K,V}|T], Name) ->
+ P = [{cons,0,{atom,0,K},{var,0,'T'}}],
+ B = [{cons,0,{integer,0,V},{call,0,{atom,0,Name},[{var,0,'T'}]}}],
+ [{clause,0,P,[],B}|gen_name2pos_cs(T, Name)];
+gen_name2pos_cs([], _) -> [].
+
+bit_clause(Name) ->
+ VarT = {var,0,'T'},
+ VarPos = {var,0,'Pos'},
+ P = [{cons,0,{tuple,0,[{atom,0,bit},VarPos]},VarT}],
+ G = [[{call,0,{atom,0,is_integer},[VarPos]}]],
+ B = [{cons,0,VarPos,{call,0,{atom,0,Name},[VarT]}}],
+ {clause,0,P,G,B}.
+
+nil_clause() ->
+ P = B = [{nil,0}],
+ {clause,0,P,[],B}.
+
+invalid_clause() ->
+ P = [{var,0,'_'}],
+ B = [{call,0,{atom,0,throw},[{atom,0,invalid}]}],
+ {clause,0,P,[],B}.
+
+%%%
+%%% Hoist alignment to reduce the number of list elements in
+%%% encode. Fewer lists elements means faster traversal in
+%%% complete/{2,3}.
+%%%
+%%% For example, the following data sequence:
+%%%
+%%% [align,<<1:1,0:1>>,[align,<<Len:16>>|Data]]
+%%%
+%%% can be rewritten to:
+%%%
+%%% [align,<<1:1,0:1,0:6>>,[<<Len:16>>|Data]]
+%%%
+%%% The change from the literal <<1:1,0:1>> to <<1:1,0:1,0:6>>
+%%% comes for free, and we have eliminated one element of the
+%%% sub list.
+%%%
+%%% We must be careful not to rewrite:
+%%%
+%%% [<<1:1,0:1>>,[align,<<Len:16>>|Data]]
+%%%
+%%% to:
+%%%
+%%% [[<<1:1,0:1>>,align],[<<Len:16>>|Data]]
+%%%
+%%% because even though [<<1:0,0:1>>,align] is a literal and does
+%%% not add any additional construction cost, there is one more
+%%% sub list that needs to be traversed.
+%%%
+
+enc_hoist_align(Imm0) ->
+ Imm = enc_hoist_align_reverse(Imm0, []),
+ enc_hoist_align(Imm, false, []).
+
+enc_hoist_align_reverse([H|T], Acc) ->
+ case enc_opt_al_1([H], 0) of
+ {[H],_} ->
+ enc_hoist_align_reverse(T, [H|Acc]);
+ {_,_} ->
+ lists:reverse(T, [H,stop|Acc])
+ end;
+enc_hoist_align_reverse([], Acc) -> Acc.
+
+enc_hoist_align([stop|T], _Aligned, Acc) ->
+ lists:reverse(T, Acc);
+enc_hoist_align([{block,Bl0}|T], Aligned, Acc) ->
+ Bl = case Aligned of
+ false -> Bl0;
+ true -> enc_hoist_block(Bl0)
+ end,
+ case is_beginning_aligned(Bl) of
+ false ->
+ enc_hoist_align(T, false, [{block,Bl}|Acc]);
+ true ->
+ enc_hoist_align(T, true, [{put_bits,0,0,[1,align]},
+ {block,Bl}|Acc])
+ end;
+enc_hoist_align([H|T], _, Acc) ->
+ enc_hoist_align(T, false, [H|Acc]);
+enc_hoist_align([], _, Acc) -> Acc.
+
+enc_hoist_block(Bl) ->
+ try
+ enc_hoist_block_1(lists:reverse(Bl))
+ catch
+ throw:impossible ->
+ Bl
+ end.
+
+enc_hoist_block_1([{'cond',Cs0}|T]) ->
+ Cs = [[C|enc_hoist_block_2(Act)] || [C|Act] <- Cs0],
+ H = {'cond',Cs},
+ lists:reverse(T, [H]);
+enc_hoist_block_1(_) ->
+ throw(impossible).
+
+enc_hoist_block_2([{'cond',_}|_]=L) ->
+ enc_hoist_block(L);
+enc_hoist_block_2([{error,_}]=L) ->
+ L;
+enc_hoist_block_2([]) ->
+ [{put_bits,0,0,[1,align]}];
+enc_hoist_block_2(L) ->
+ case lists:last(L) of
+ {put_bits,_,_,_} ->
+ L ++ [{put_bits,0,0,[1,align]}];
+ _ ->
+ throw(impossible)
+ end.
+
+%%%
+%%% Optimize alignment for encoding.
+%%%
+
+enc_opt_al(Imm0) ->
+ {Imm,_} = enc_opt_al_1(Imm0, unknown),
+ Imm.
+
+enc_opt_al_1([{'cond',Cs0,Dst},{call,per,complete,[Dst],Bin}|T0], Al0) ->
+ {Cs1,{M,F}} = enc_opt_al_prepare_cond(Cs0),
+ {Cs,_} = enc_opt_al_cond(Cs1, 0),
+ {T,Al} = enc_opt_al_1([{call,M,F,[Dst],Bin}|T0], Al0),
+ {[{'cond',Cs,Dst}|T],Al};
+enc_opt_al_1([H0|T0], Al0) ->
+ {H,Al1} = enc_opt_al(H0, Al0),
+ {T,Al} = enc_opt_al_1(T0, Al1),
+ {H++T,Al};
+enc_opt_al_1([], Al) -> {[],Al}.
+
+enc_opt_al({apply,_,_,_}=Imm, Al) ->
+ {[Imm],Al};
+enc_opt_al({assign,_,_}=Imm, Al) ->
+ {[Imm],Al};
+enc_opt_al({block,Bl0}, Al0) ->
+ {Bl,Al} = enc_opt_al_1(Bl0, Al0),
+ {[{block,Bl}],Al};
+enc_opt_al({call,erlang,iolist_to_binary,[_]}=Imm, Al) ->
+ {[Imm],Al};
+enc_opt_al({call,per_common,encode_fragmented,[_,U]}=Call, Al) ->
+ case U rem 8 of
+ 0 -> {[Call],Al};
+ _ -> {[Call],unknown}
+ end;
+enc_opt_al({call,per_common,encode_unconstrained_number,[_]}=Call, _) ->
+ {[Call],0};
+enc_opt_al({call,_,_,_,_}=Call, Al) ->
+ {[Call],Al};
+enc_opt_al({'cond',Cs0}, Al0) ->
+ {Cs,Al} = enc_opt_al_cond(Cs0, Al0),
+ {[{'cond',Cs}],Al};
+enc_opt_al({error,_}=Imm, Al) ->
+ {[Imm],Al};
+enc_opt_al({put_bits,V,N,[U,align]}, Al0) when Al0 rem 8 =:= 0 ->
+ Al = if
+ is_integer(N) -> N*U;
+ N =:= binary, U rem 8 =:= 0 -> 0;
+ true -> unknown
+ end,
+ {[{put_bits,V,N,[U]}],Al};
+enc_opt_al({put_bits,V,binary,[U,align]}, Al0) when is_integer(Al0) ->
+ N = 8 - (Al0 rem 8),
+ Al = case U rem 8 of
+ 0 -> 0;
+ _ -> unknown
+ end,
+ {[{put_bits,0,N,[1]},{put_bits,V,binary,[U]}],Al};
+enc_opt_al({put_bits,V,N0,[U,align]}, Al0) when is_integer(N0), is_integer(Al0) ->
+ N = N0 + (8 - Al0 rem 8),
+ Al = N0*U,
+ {[{put_bits,V,N,[1]}],Al};
+enc_opt_al({put_bits,_,N,[U,align]}=PutBits, _) when is_integer(N) ->
+ {[PutBits],N*U};
+enc_opt_al({put_bits,_,binary,[U,align]}=PutBits, _) when U rem 8 =:= 0 ->
+ {[PutBits],0};
+enc_opt_al({put_bits,_,N,[U]}=PutBits, Al) when is_integer(N), is_integer(Al) ->
+ {[PutBits],Al+N*U};
+enc_opt_al({put_bits,_,binary,[U]}=PutBits, Al) when U rem 8 =:= 0 ->
+ {[PutBits],Al};
+enc_opt_al({sub,_,_,_}=Imm, Al) ->
+ {[Imm],Al};
+enc_opt_al(Imm, _) ->
+ {[Imm],unknown}.
+
+enc_opt_al_cond(Cs0, Al0) ->
+ enc_opt_al_cond_1(Cs0, Al0, [], []).
+
+enc_opt_al_cond_1([['_',{error,_}]=C|Cs], Al, CAcc, AAcc) ->
+ enc_opt_al_cond_1(Cs, Al, [C|CAcc], AAcc);
+enc_opt_al_cond_1([[C|Act0]|Cs0], Al0, CAcc, AAcc) ->
+ {Act,Al1} = enc_opt_al_1(Act0, Al0),
+ Al = if
+ Al1 =:= unknown -> Al1;
+ true -> Al1 rem 8
+ end,
+ enc_opt_al_cond_1(Cs0, Al0, [[C|Act]|CAcc], [Al|AAcc]);
+enc_opt_al_cond_1([], _, CAcc, AAcc) ->
+ Al = case lists:usort(AAcc) of
+ [] -> unknown;
+ [Al0] -> Al0;
+ [_|_] -> unknown
+ end,
+ {lists:reverse(CAcc),Al}.
+
+enc_opt_al_prepare_cond(Cs0) ->
+ try enc_opt_al_prepare_cond_1(Cs0) of
+ Cs ->
+ {Cs,{erlang,iolist_to_binary}}
+ catch
+ throw:impossible ->
+ {Cs0,{per,complete}}
+ end.
+
+enc_opt_al_prepare_cond_1(Cs) ->
+ [[C|enc_opt_al_prepare_cond_2(Act)] || [C|Act] <- Cs].
+
+enc_opt_al_prepare_cond_2([{put_bits,_,binary,[U|_]}|_]) when U rem 8 =/= 0 ->
+ throw(impossible);
+enc_opt_al_prepare_cond_2([{put_bits,_,_,_}=H|T]) ->
+ [H|enc_opt_al_prepare_cond_2(T)];
+enc_opt_al_prepare_cond_2([{call,per_common,encode_fragmented,_}=H|T]) ->
+ [H|enc_opt_al_prepare_cond_2(T)];
+enc_opt_al_prepare_cond_2([_|_]) ->
+ throw(impossible);
+enc_opt_al_prepare_cond_2([]) ->
+ [{put_bits,0,0,[1,align]}].
+
+
+%%%
+%%% For the aligned PER format, fix up the intermediate format
+%%% before code generation. Code generation will be somewhat
+%%% easier if 'align' appear as a separate instruction.
+%%%
+
+per_fixup([{apply,_,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{apply,_,_,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{block,Block}|T]) ->
+ [{block,per_fixup(Block)}|per_fixup(T)];
+per_fixup([{'assign',_,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{'cond',Cs0}|T]) ->
+ Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0],
+ [{'cond',Cs}|per_fixup(T)];
+per_fixup([{'cond',Cs0,Dst}|T]) ->
+ Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0],
+ [{'cond',Cs,Dst}|per_fixup(T)];
+per_fixup([{call,_,_,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{call,_,_,_,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{call_gen,_,_,_,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{error,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{lc,B,V,L}|T]) ->
+ [{lc,per_fixup(B),V,L}|per_fixup(T)];
+per_fixup([{lc,B,V,L,Dst}|T]) ->
+ [{lc,per_fixup(B),V,L,Dst}|per_fixup(T)];
+per_fixup([{sub,_,_,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([{'try',Try0,{P,Succ0},Else0,Dst}|T]) ->
+ Try = per_fixup(Try0),
+ Succ = per_fixup(Succ0),
+ Else = per_fixup(Else0),
+ [{'try',Try,{P,Succ},Else,Dst}|per_fixup(T)];
+per_fixup([{put_bits,_,_,_}|_]=L) ->
+ fixup_put_bits(L);
+per_fixup([{var,_}=H|T]) ->
+ [H|per_fixup(T)];
+per_fixup([]) -> [].
+
+fixup_put_bits([{put_bits,0,0,[_,align]}|T]) ->
+ [align|fixup_put_bits(T)];
+fixup_put_bits([{put_bits,0,0,_}|T]) ->
+ fixup_put_bits(T);
+fixup_put_bits([{put_bits,V,N,[U,align]}|T]) ->
+ [align,{put_bits,V,N,[U]}|fixup_put_bits(T)];
+fixup_put_bits([{put_bits,_,_,_}=H|T]) ->
+ [H|fixup_put_bits(T)];
+fixup_put_bits(Other) -> per_fixup(Other).
+
%% effective_constraint(Type,C)
%% Type = atom()
%% C = [C1,...]
diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl
index ecdfa3f645..992210232f 100644
--- a/lib/asn1/src/asn1ct_value.erl
+++ b/lib/asn1/src/asn1ct_value.erl
@@ -32,11 +32,11 @@
from_type(M,Typename) ->
- case asn1_db:dbget(M,Typename) of
- undefined ->
+ case asn1_db:dbload(M) of
+ error ->
{error,{not_found,{M,Typename}}};
- Tdef when is_record(Tdef,typedef) ->
- Type = Tdef#typedef.typespec,
+ ok ->
+ #typedef{typespec=Type} = asn1_db:dbget(M, Typename),
from_type(M,[Typename],Type);
Vdef when is_record(Vdef,valuedef) ->
from_value(Vdef);
diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl
index b5429fe324..583ff790b7 100644
--- a/lib/asn1/src/asn1rtt_ber.erl
+++ b/lib/asn1/src/asn1rtt_ber.erl
@@ -22,8 +22,7 @@
%% encoding / decoding of BER
-export([ber_decode_nif/1,ber_decode_erlang/1,match_tags/2,ber_encode/1]).
--export([encode_tags/2,
- encode_tags/3,
+-export([encode_tags/3,
skip_ExtensionAdditions/2]).
-export([encode_boolean/2,decode_boolean/2,
encode_integer/2,encode_integer/3,
diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl
index 9f4b7500d8..672c84593c 100644
--- a/lib/asn1/src/asn1rtt_per.erl
+++ b/lib/asn1/src/asn1rtt_per.erl
@@ -18,62 +18,7 @@
%%
-module(asn1rtt_per).
--export([setext/1, fixextensions/2,
- skipextensions/3,
- set_choice/3,encode_integer/2,
- encode_small_number/1,
- encode_constrained_number/2,
- encode_length/1,
- encode_length/2,
- encode_bit_string/3,
- encode_object_identifier/1,
- encode_relative_oid/1,
- complete/1,
- encode_open_type/1,
- encode_GeneralString/2,
- encode_GraphicString/2,
- encode_TeletexString/2,
- encode_VideotexString/2,
- encode_ObjectDescriptor/2,
- encode_UTF8String/1,
- encode_octet_string/2,
- encode_known_multiplier_string/4,
- octets_to_complete/2]).
-
--define('16K',16384).
--define('32K',32768).
--define('64K',65536).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% setext(true|false) -> CompleteList
-%%
-
-setext(false) ->
- [0];
-setext(true) ->
- [1].
-
-fixextensions({ext,ExtPos,ExtNum},Val) ->
- case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of
- 0 -> [];
- ExtBits ->
- [encode_small_length(ExtNum)|pre_complete_bits(ExtNum,ExtBits)]
- end.
-
-fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos ->
- Acc;
-fixextensions(Pos,ExtPos,Val,Acc) ->
- Bit = case catch(element(Pos+1,Val)) of
- asn1_NOVALUE ->
- 0;
- asn1_NOEXTVALUE ->
- 0;
- {'EXIT',_} ->
- 0;
- _ ->
- 1
- end,
- fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit).
+-export([skipextensions/3,complete/1]).
skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) ->
Prev = Nr - 1,
@@ -95,270 +40,6 @@ align(BitStr) when is_bitstring(BitStr) ->
<<_:AlignBits,Rest/binary>> = BitStr,
Rest.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings
-%% Alt = atom()
-%% Altnum = integer() | {integer(),integer()}% number of alternatives
-%% Choices = [atom()] | {[atom()],[atom()]}
-%% When Choices is a tuple the first list is the Rootset and the
-%% second is the Extensions and then Altnum must also be a tuple with the
-%% lengths of the 2 lists
-%%
-set_choice(Alt,{L1,L2},{Len1,_Len2}) ->
- case set_choice_tag(Alt,L1) of
- N when is_integer(N), Len1 > 1 ->
- [0, % the value is in the root set
- encode_constrained_number({0,Len1-1},N)];
- N when is_integer(N) ->
- [0]; % no encoding if only 0 or 1 alternative
- false ->
- [1, % extension value
- case set_choice_tag(Alt, L2) of
- N2 when is_integer(N2) ->
- encode_small_number(N2);
- false ->
- unknown_choice_alt
- end]
- end;
-set_choice(Alt, L, Len) ->
- case set_choice_tag(Alt, L) of
- N when is_integer(N), Len > 1 ->
- encode_constrained_number({0,Len-1},N);
- N when is_integer(N) ->
- []; % no encoding if only 0 or 1 alternative
- false ->
- [unknown_choice_alt]
- end.
-
-set_choice_tag(Alt,Choices) ->
- set_choice_tag(Alt,Choices,0).
-
-set_choice_tag(Alt,[Alt|_Rest],Tag) ->
- Tag;
-set_choice_tag(Alt,[_H|Rest],Tag) ->
- set_choice_tag(Alt,Rest,Tag+1);
-set_choice_tag(_Alt,[],_Tag) ->
- false.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_open_type(Constraint, Value) -> CompleteList
-%% Value = list of bytes of an already encoded value (the list must be flat)
-%% | binary
-%% Contraint = not used in this version
-%%
-encode_open_type(Val) ->
- case byte_size(Val) of
- Size when Size > 255 ->
- [encode_length(Size),21,<<Size:16>>,Val]; % octets implies align
- Size ->
- [encode_length(Size),20,Size,Val]
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_integer(Constraint, Value) -> CompleteList
-%%
-encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) ->
- try
- [0|encode_integer([Rc], Val)]
- catch
- _:{error,{asn1,_}} ->
- [1|encode_unconstrained_number(Val)]
- end;
-encode_integer([], Val) ->
- encode_unconstrained_number(Val);
-%% The constraint is the effective constraint, and in this case is a number
-encode_integer([{'SingleValue',V}], V) ->
- [];
-encode_integer([{'ValueRange',{Lb,Ub}=VR,Range,PreEnc}],Val)
- when Val >= Lb, Ub >= Val ->
- %% this case when NamedNumberList
- encode_constrained_number(VR, Range, PreEnc, Val);
-encode_integer([{'ValueRange',{Lb,'MAX'}}], Val) when Lb =< Val ->
- encode_semi_constrained_number(Lb, Val);
-encode_integer([{'ValueRange',{'MIN',_}}], Val) ->
- encode_unconstrained_number(Val);
-encode_integer([{'ValueRange',VR={_Lb,_Ub}}], Val) ->
- encode_constrained_number(VR, Val);
-encode_integer(_,Val) ->
- exit({error,{asn1,{illegal_value,Val}}}).
-
-
-%% X.691:10.6 Encoding of a normally small non-negative whole number
-%% Use this for encoding of CHOICE index if there is an extension marker in
-%% the CHOICE
-encode_small_number(Val) when Val < 64 ->
- [10,7,Val];
-encode_small_number(Val) ->
- [1|encode_semi_constrained_number(0, Val)].
-
-%% X.691:10.7 Encoding of a semi-constrained whole number
-encode_semi_constrained_number(Lb, Val) ->
- Val2 = Val - Lb,
- Oct = eint_positive(Val2),
- Len = length(Oct),
- if
- Len < 128 ->
- [20,Len+1,Len|Oct];
- Len < 256 ->
- [encode_length(Len),20,Len|Oct];
- true ->
- [encode_length(Len),21,<<Len:16>>|Oct]
- end.
-
-encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) ->
- Val2 = Val-Lb,
- [10,N,Val2];
-encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) when N < 256->
- %% N is 8 or 16 (1 or 2 octets)
- Val2 = Val-Lb,
- [20,N,Val2];
-encode_constrained_number({Lb,_Ub},_Range,{octets,N},Val) -> % N>255
- %% N is 8 or 16 (1 or 2 octets)
- Val2 = Val-Lb,
- [21,<<N:16>>,Val2];
-encode_constrained_number({Lb,_Ub},Range,_,Val) ->
- Val2 = Val-Lb,
- if
- Range =< 16#1000000 -> % max 3 octets
- Octs = eint_positive(Val2),
- L = length(Octs),
- [encode_length({1,3},L),[20,L,Octs]];
- Range =< 16#100000000 -> % max 4 octets
- Octs = eint_positive(Val2),
- L = length(Octs),
- [encode_length({1,4},L),[20,L,Octs]];
- Range =< 16#10000000000 -> % max 5 octets
- Octs = eint_positive(Val2),
- L = length(Octs),
- [encode_length({1,5},L),[20,L,Octs]];
- true ->
- exit({not_supported,{integer_range,Range}})
- end.
-
-encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
- Range = Ub - Lb + 1,
- Val2 = Val - Lb,
- if
- Range == 1 -> [];
- Range == 2 ->
- [Val2];
- Range =< 4 ->
- [10,2,Val2];
- Range =< 8 ->
- [10,3,Val2];
- Range =< 16 ->
- [10,4,Val2];
- Range =< 32 ->
- [10,5,Val2];
- Range =< 64 ->
- [10,6,Val2];
- Range =< 128 ->
- [10,7,Val2];
- Range =< 255 ->
- [10,8,Val2];
- Range =< 256 ->
- [20,1,Val2];
- Range =< 65536 ->
- [20,2,<<Val2:16>>];
- Range =< (1 bsl (255*8)) ->
- Octs = binary:encode_unsigned(Val2),
- RangeOcts = binary:encode_unsigned(Range - 1),
- OctsLen = byte_size(Octs),
- RangeOctsLen = byte_size(RangeOcts),
- LengthBitsNeeded = minimum_bits(RangeOctsLen - 1),
- [10,LengthBitsNeeded,OctsLen-1,20,OctsLen,Octs];
- true ->
- exit({not_supported,{integer_range,Range}})
- end;
-encode_constrained_number({_,_},Val) ->
- exit({error,{asn1,{illegal_value,Val}}}).
-
-%% For some reason the minimum bits needed in the length field in
-%% the encoding of constrained whole numbers must always be at least 2?
-minimum_bits(N) when N < 4 -> 2;
-minimum_bits(N) when N < 8 -> 3;
-minimum_bits(N) when N < 16 -> 4;
-minimum_bits(N) when N < 32 -> 5;
-minimum_bits(N) when N < 64 -> 6;
-minimum_bits(N) when N < 128 -> 7;
-minimum_bits(_N) -> 8.
-
-%% X.691:10.8 Encoding of an unconstrained whole number
-
-encode_unconstrained_number(Val) ->
- Oct = if
- Val >= 0 ->
- eint(Val, []);
- true ->
- enint(Val, [])
- end,
- Len = length(Oct),
- if
- Len < 128 ->
- [20,Len + 1,Len|Oct];
- Len < 256 ->
- [20,Len + 2,<<2:2,Len:14>>|Oct];
- true ->
- [encode_length(Len),21,<<Len:16>>|Oct]
- end.
-
-%% used for positive Values which don't need a sign bit
-%% returns a list
-eint_positive(Val) ->
- case eint(Val,[]) of
- [0,B1|T] ->
- [B1|T];
- T ->
- T
- end.
-
-
-eint(0, [B|Acc]) when B < 128 ->
- [B|Acc];
-eint(N, Acc) ->
- eint(N bsr 8, [N band 16#ff| Acc]).
-
-enint(-1, [B1|T]) when B1 > 127 ->
- [B1|T];
-enint(N, Acc) ->
- enint(N bsr 8, [N band 16#ff|Acc]).
-
-%% X.691:10.9 Encoding of a length determinant
-%%encode_small_length(undefined,Len) -> % null means no UpperBound
-%% encode_small_number(Len).
-
-%% X.691:10.9.3.5
-%% X.691:10.9.3.7
-encode_length(Len) -> % unconstrained
- if
- Len < 128 ->
- [20,1,Len];
- Len < 16384 ->
- <<20,2,2:2,Len:14>>;
- true -> % should be able to endode length >= 16384 i.e. fragmented length
- exit({error,{asn1,{encode_length,{nyi,above_16k}}}})
- end.
-
-encode_length({C,[]}, Len) ->
- case C of
- {Lb,Ub}=Vr when Lb =< Len, Len =< Ub ->
- [0|encode_constrained_number(Vr, Len)];
- _ ->
- [1|encode_length(Len)]
- end;
-encode_length(Len, Len) ->
- [];
-encode_length(Vr, Len) ->
- encode_constrained_number(Vr, Len).
-
-%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension
-%% additions in a sequence or set
-encode_small_length(Len) when Len =< 64 ->
- [10,7,Len-1];
-encode_small_length(Len) ->
- [1,encode_length(Len)].
-
-
decode_length(Buffer) -> % un-constrained
case align(Buffer) of
<<0:1,Oct:7,Rest/binary>> ->
@@ -370,511 +51,70 @@ decode_length(Buffer) -> % un-constrained
exit({error,{asn1,{decode_length,{nyi,above_16k}}}})
end.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% bitstring NamedBitList
-%% Val can be of:
-%% - [identifiers] where only named identifers are set to one,
-%% the Constraint must then have some information of the
-%% bitlength.
-%% - [list of ones and zeroes] all bits
-%% - integer value representing the bitlist
-%% C is constraint Len, only valid when identifiers
-
-
-%% when the value is a list of {Unused,BinBits}, where
-%% Unused = integer(),
-%% BinBits = binary().
-
-encode_bit_string(C, Bits, NamedBitList) when is_bitstring(Bits) ->
- PadLen = (8 - (bit_size(Bits) band 7)) band 7,
- Compact = {PadLen,<<Bits/bitstring,0:PadLen>>},
- encode_bin_bit_string(C, Compact, NamedBitList);
-encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList)
- when is_integer(Unused), is_binary(BinBits) ->
- encode_bin_bit_string(C,Bin,NamedBitList);
-
-%% when the value is a list of named bits
-
-encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) ->
- ToSetPos = get_all_bitposes(LoNB, NamedBitList, []),
- BitList = make_and_set_list(ToSetPos,0),
- encode_bit_string(C,BitList,NamedBitList);% consider the constraint
-
-encode_bit_string(C, BL=[{bit,_} | _RestVal], NamedBitList) ->
- ToSetPos = get_all_bitposes(BL, NamedBitList, []),
- BitList = make_and_set_list(ToSetPos,0),
- encode_bit_string(C,BitList,NamedBitList);
-
-%% when the value is a list of ones and zeroes
-encode_bit_string(Int, BitListValue, _)
- when is_list(BitListValue),is_integer(Int),Int =< 16 ->
- %% The type is constrained by a single value size constraint
- %% range_check(Int,length(BitListValue)),
- [40,Int,length(BitListValue),BitListValue];
-encode_bit_string(Int, BitListValue, _)
- when is_list(BitListValue),is_integer(Int), Int =< 255 ->
- %% The type is constrained by a single value size constraint
- %% range_check(Int,length(BitListValue)),
- [2,40,Int,length(BitListValue),BitListValue];
-encode_bit_string(Int, BitListValue, _)
- when is_list(BitListValue),is_integer(Int), Int < ?'64K' ->
- {Code,DesiredLength,Length} =
- case length(BitListValue) of
- B1 when B1 > Int ->
- exit({error,{'BIT_STRING_length_greater_than_SIZE',
- Int,BitListValue}});
- B1 when B1 =< 255,Int =< 255 ->
- {40,Int,B1};
- B1 when B1 =< 255 ->
- {42,<<Int:16>>,B1};
- B1 ->
- {43,<<Int:16>>,<<B1:16>>}
- end,
- %% The type is constrained by a single value size constraint
- [2,Code,DesiredLength,Length,BitListValue];
-encode_bit_string(no, BitListValue,[])
- when is_list(BitListValue) ->
- [encode_length(length(BitListValue)),
- 2|BitListValue];
-encode_bit_string({{Fix,Fix},Ext}, BitListValue,[])
- when is_integer(Fix), is_list(Ext) ->
- case length(BitListValue) of
- Len when Len =< Fix ->
- [0|encode_bit_string(Fix, BitListValue, [])];
- _ ->
- [1|encode_bit_string(no, BitListValue, [])]
- end;
-encode_bit_string(C, BitListValue,[])
- when is_list(BitListValue) ->
- [encode_length(C, length(BitListValue)),
- 2|BitListValue];
-encode_bit_string(no, BitListValue,_NamedBitList)
- when is_list(BitListValue) ->
- %% this case with an unconstrained BIT STRING can be made more efficient
- %% if the complete driver can take a special code so the length field
- %% is encoded there.
- NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end,
- lists:reverse(BitListValue))),
- [encode_length(length(NewBitLVal)),2|NewBitLVal];
-encode_bit_string({{Fix,Fix},Ext}, BitListValue, NamedBitList)
- when is_integer(Fix), is_list(Ext) ->
- case length(BitListValue) of
- Len when Len =< Fix ->
- [0|encode_bit_string(Fix, BitListValue, NamedBitList)];
- _ ->
- [1|encode_bit_string(no, BitListValue, NamedBitList)]
- end;
-encode_bit_string(C, BitListValue, _NamedBitList)
- when is_list(BitListValue) -> % C = {_,'MAX'}
- NewBitLVal = bit_string_trailing_zeros(BitListValue, C),
- [encode_length(C, length(NewBitLVal)),2|NewBitLVal];
-
-
-%% when the value is an integer
-encode_bit_string(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)->
- BitList = int_to_bitlist(IntegerVal),
- encode_bit_string(C,BitList,NamedBitList).
-
-bit_string_trailing_zeros(BitList,C) when is_integer(C) ->
- bit_string_trailing_zeros1(BitList,C,C);
-bit_string_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) ->
- bit_string_trailing_zeros1(BitList,Lb,Ub);
-bit_string_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) ->
- bit_string_trailing_zeros1(BitList,Lb,Ub);
-bit_string_trailing_zeros(BitList,_) ->
- BitList.
-
-bit_string_trailing_zeros1(BitList,Lb,Ub) ->
- case length(BitList) of
- Lb -> BitList;
- B when B < Lb -> BitList++lists:duplicate(Lb-B, 0);
- D -> F = fun(L,LB,LB,_,_)->lists:reverse(L);
- ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun);
- (L,L1,_,UB,_)when L1 =< UB -> lists:reverse(L);
- (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING,
- BitList}}) end,
- F(lists:reverse(BitList),D,Lb,Ub,F)
- end.
-
-%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits.
-%% Unused = integer(),i.e. number unused bits in least sign. byte of
-%% BinBits = binary().
-encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList)
- when is_integer(C),C=<16 ->
- range_check(C, bit_size(BinBits) - Unused),
- [45,C,byte_size(BinBits),BinBits];
-encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList)
- when is_integer(C), C =< 255 ->
- range_check(C, bit_size(BinBits) - Unused),
- [2,45,C,byte_size(BinBits),BinBits];
-encode_bin_bit_string(C, {Unused,BinBits}, _NamedBitList)
- when is_integer(C), C =< 65535 ->
- range_check(C, bit_size(BinBits) - Unused),
- case byte_size(BinBits) of
- Size when Size =< 255 ->
- [2,46,<<C:16>>,Size,BinBits];
- Size ->
- [2,47,<<C:16>>,<<Size:16>>,BinBits]
- end;
-encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) ->
- {Unused1,Bin1} =
- %% removes all trailing bits if NamedBitList is not empty
- remove_trailing_bin(NamedBitList,UnusedAndBin),
- case C of
- {Lb,Ub} when is_integer(Lb),is_integer(Ub) ->
- Size = byte_size(Bin1),
- [encode_length({Lb,Ub}, Size*8 - Unused1),
- 2,octets_unused_to_complete(Unused1,Size,Bin1)];
- no ->
- Size = byte_size(Bin1),
- [encode_length(Size*8 - Unused1),
- 2|octets_unused_to_complete(Unused1, Size, Bin1)];
- {{Fix,Fix},Ext} when is_integer(Fix),is_list(Ext) ->
- case byte_size(Bin1)*8 - Unused1 of
- Size when Size =< Fix ->
- [0|encode_bin_bit_string(Fix,UnusedAndBin,NamedBitList)];
- _Size ->
- [1|encode_bin_bit_string(no,UnusedAndBin,NamedBitList)]
- end;
- Sc ->
- Size = byte_size(Bin1),
- [encode_length(Sc, Size*8 - Unused1),
- 2|octets_unused_to_complete(Unused1,Size,Bin1)]
- end.
-
-range_check(C,C) when is_integer(C) ->
- ok;
-range_check(C1,C2) when is_integer(C1) ->
- exit({error,{asn1,{bit_string_out_of_range,{C1,C2}}}}).
-
-remove_trailing_bin([], {Unused,Bin}) ->
- {Unused,Bin};
-remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) ->
- {0,<<>>};
-remove_trailing_bin(NamedNumberList, {_Unused,Bin}) ->
- Size = byte_size(Bin)-1,
- <<Bfront:Size/binary, LastByte:8>> = Bin,
- %% clear the Unused bits to be sure
- Unused1 = trailingZeroesInNibble(LastByte band 15),
- Unused2 =
- case Unused1 of
- 4 ->
- 4 + trailingZeroesInNibble(LastByte bsr 4);
- _ -> Unused1
- end,
- case Unused2 of
- 8 ->
- remove_trailing_bin(NamedNumberList,{0,Bfront});
- _ ->
- {Unused2,Bin}
- end.
-
-
-trailingZeroesInNibble(0) ->
- 4;
-trailingZeroesInNibble(1) ->
- 0;
-trailingZeroesInNibble(2) ->
- 1;
-trailingZeroesInNibble(3) ->
- 0;
-trailingZeroesInNibble(4) ->
- 2;
-trailingZeroesInNibble(5) ->
- 0;
-trailingZeroesInNibble(6) ->
- 1;
-trailingZeroesInNibble(7) ->
- 0;
-trailingZeroesInNibble(8) ->
- 3;
-trailingZeroesInNibble(9) ->
- 0;
-trailingZeroesInNibble(10) ->
- 1;
-trailingZeroesInNibble(11) ->
- 0;
-trailingZeroesInNibble(12) -> %#1100
- 2;
-trailingZeroesInNibble(13) ->
- 0;
-trailingZeroesInNibble(14) ->
- 1;
-trailingZeroesInNibble(15) ->
- 0.
-
-
-%%%%%%%%%%%%%%%
-%%
-
-int_to_bitlist(Int) when is_integer(Int), Int > 0 ->
- [Int band 1 | int_to_bitlist(Int bsr 1)];
-int_to_bitlist(0) ->
- [].
-
-
-%%%%%%%%%%%%%%%%%%
-%% get_all_bitposes([list of named bits to set], named_bit_db, []) ->
-%% [sorted_list_of_bitpositions_to_set]
-
-get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) ->
- get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]);
-
-get_all_bitposes([Val | Rest], NamedBitList, Ack) ->
- case lists:keyfind(Val, 1, NamedBitList) of
- {_ValName, ValPos} ->
- get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]);
- false ->
- exit({error,{asn1, {bitstring_namedbit, Val}}})
- end;
-get_all_bitposes([], _NamedBitList, Ack) ->
- lists:sort(Ack).
-
-%%%%%%%%%%%%%%%%%%
-%% make_and_set_list([list of positions to set to 1])->
-%% returns list with all in SetPos set.
-%% in positioning in list the first element is 0, the second 1 etc.., but
-%%
-
-make_and_set_list([XPos|SetPos], XPos) ->
- [1 | make_and_set_list(SetPos, XPos + 1)];
-make_and_set_list([Pos|SetPos], XPos) ->
- [0 | make_and_set_list([Pos | SetPos], XPos + 1)];
-make_and_set_list([], _) ->
- [].
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% X.691:16
-%% encode_octet_string(Constraint, Val)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-encode_octet_string({{Sv,Sv},Ext}=SZ, Val) when is_list(Ext), Sv =< 2 ->
- Len = length(Val),
- try
- case encode_length(SZ, Len) of
- [0|_]=EncLen ->
- [EncLen,45,Sv*8,Sv,Val];
- [_|_]=EncLen ->
- [EncLen|octets_to_complete(Len, Val)]
- end
- catch
- exit:{error,{asn1,{encode_length,_}}} ->
- encode_fragmented_octet_string(Val)
- end;
-encode_octet_string({_,_}=SZ, Val) ->
- Len = length(Val),
- try
- [encode_length(SZ, Len),2|octets_to_complete(Len, Val)]
- catch
- exit:{error,{asn1,{encode_length,_}}} ->
- encode_fragmented_octet_string(Val)
- end;
-encode_octet_string(Sv, Val) when is_integer(Sv) ->
- encode_fragmented_octet_string(Val);
-encode_octet_string(no, Val) ->
- Len = length(Val),
- try
- [encode_length(Len),2|octets_to_complete(Len, Val)]
- catch
- exit:{error,{asn1,{encode_length,_}}} ->
- encode_fragmented_octet_string(Val)
- end.
-
-encode_fragmented_octet_string(Val) ->
- Bin = iolist_to_binary(Val),
- efos_1(Bin).
-
-efos_1(<<B1:16#C000/binary,B2:16#4000/binary,T/binary>>) ->
- [20,1,<<3:2,4:6>>,
- octets_to_complete(16#C000, B1),
- octets_to_complete(16#4000, B2)|efos_1(T)];
-efos_1(<<B:16#C000/binary,T/binary>>) ->
- [20,1,<<3:2,3:6>>,octets_to_complete(16#C000, B)|efos_1(T)];
-efos_1(<<B:16#8000/binary,T/binary>>) ->
- [20,1,<<3:2,2:6>>,octets_to_complete(16#8000, B)|efos_1(T)];
-efos_1(<<B:16#4000/binary,T/binary>>) ->
- [20,1,<<3:2,1:6>>,octets_to_complete(16#4000, B)|efos_1(T)];
-efos_1(<<>>) ->
- [20,1,0];
-efos_1(<<B/bitstring>>) ->
- Len = byte_size(B),
- [encode_length(Len)|octets_to_complete(Len, B)].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Restricted char string types
-%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString)
-%% X.691:26 and X.680:34-36
-
-encode_restricted_string(Val) when is_list(Val)->
- Len = length(Val),
- [encode_length(Len)|octets_to_complete(Len, Val)].
-
-encode_known_multiplier_string(SizeC, NumBits, CharOutTab, Val) ->
- Result = chars_encode2(Val, NumBits, CharOutTab),
- case SizeC of
- Ub when is_integer(Ub), Ub*NumBits < 16 ->
- Result;
- Ub when is_integer(Ub) ->
- [2,Result];
- {{_,Ub},Ext}=SZ when is_list(Ext) ->
- Len = length(Val),
- case encode_length(SZ, Len) of
- [0|_]=EncLen when Ub*NumBits < 16 ->
- [EncLen,45,Len*NumBits,Len,Val];
- [_|_]=EncLen ->
- [EncLen,2|Result]
- end;
- {_,Ub}=Range ->
- [encode_length(Range, length(Val))|
- if
- Ub*NumBits < 16 -> Result;
- true -> [2|Result]
- end];
- no ->
- [encode_length(length(Val)),2,Result]
- end.
-
-encode_GeneralString(_C,Val) ->
- encode_restricted_string(Val).
-
-encode_GraphicString(_C,Val) ->
- encode_restricted_string(Val).
-
-encode_ObjectDescriptor(_C,Val) ->
- encode_restricted_string(Val).
-
-encode_TeletexString(_C,Val) -> % equivalent with T61String
- encode_restricted_string(Val).
-
-encode_VideotexString(_C,Val) ->
- encode_restricted_string(Val).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% chars_encode(C,StringType,Value) -> ValueList
-%%
-%% encodes chars according to the per rules taking the constraint
-%% PermittedAlphabet into account.
-%%
-%% This function only encodes the value part and NOT the length.
-
-chars_encode2([H|T],NumBits,T1={Min,Max,notab}) when H =< Max, H >= Min ->
- [pre_complete_bits(NumBits,H-Min)|chars_encode2(T,NumBits,T1)];
-chars_encode2([H|T],NumBits,T1={Min,Max,Tab}) when H =< Max, H >= Min ->
- [pre_complete_bits(NumBits,exit_if_false(H,element(H-Min+1,Tab)))|
- chars_encode2(T,NumBits,T1)];
-chars_encode2([{A,B,C,D}|T],NumBits,T1={Min,_Max,notab}) ->
- %% no value range check here (ought to be, but very expensive)
- [pre_complete_bits(NumBits,
- ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min)|
- chars_encode2(T,NumBits,T1)];
-chars_encode2([H={A,B,C,D}|T],NumBits,{Min,Max,Tab}) ->
- %% no value range check here (ought to be, but very expensive)
- [pre_complete_bits(NumBits,exit_if_false(H,element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)))|chars_encode2(T,NumBits,{Min,Max,notab})];
-chars_encode2([H|_T],_NumBits,{_Min,_Max,_Tab}) ->
- exit({error,{asn1,{illegal_char_value,H}}});
-chars_encode2([],_,_) ->
- [].
-
-exit_if_false(V,false)->
- exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}});
-exit_if_false(_,V) ->V.
-
-pre_complete_bits(NumBits,Val) when NumBits =< 8 ->
- [10,NumBits,Val];
-pre_complete_bits(NumBits,Val) when NumBits =< 16 ->
- [10,NumBits-8,Val bsr 8,10,8,(Val band 255)];
-pre_complete_bits(NumBits,Val) when NumBits =< 2040 -> % 255 * 8
- Unused = (8 - (NumBits rem 8)) rem 8,
- Len = NumBits + Unused,
- [30,Unused,Len div 8,<<(Val bsl Unused):Len>>].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_UTF8String(Val) -> CompleteList
-%% Val -> <<utf8encoded binary>>
-%% CompleteList -> [apropriate codes and values for driver complete]
-%%
-encode_UTF8String(Val) when is_binary(Val) ->
- Sz = byte_size(Val),
- [encode_length(Sz),octets_to_complete(Sz, Val)];
-encode_UTF8String(Val) ->
- encode_UTF8String(list_to_binary(Val)).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_object_identifier(Val) -> CompleteList
-%% encode_object_identifier({Name,Val}) -> CompleteList
-%% Val -> {Int1,Int2,...,IntN} % N >= 2
-%% Name -> atom()
-%% Int1 -> integer(0..2)
-%% Int2 -> integer(0..39) when Int1 (0..1) else integer()
-%% Int3-N -> integer()
-%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...]
-%%
-encode_object_identifier(Val) ->
- OctetList = e_object_identifier(Val),
- Octets = list_to_binary(OctetList),
- Sz = byte_size(Octets),
- [encode_length(Sz),
- octets_to_complete(Sz, Octets)].
-
-e_object_identifier({'OBJECT IDENTIFIER',V}) ->
- e_object_identifier(V);
-e_object_identifier(V) when is_tuple(V) ->
- e_object_identifier(tuple_to_list(V));
-
-%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1)
-e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 ->
- Head = 40*E1 + E2, % weird
- e_object_elements([Head|Tail],[]);
-e_object_identifier(Oid=[_,_|_Tail]) ->
- exit({error,{asn1,{'illegal_value',Oid}}}).
-
-e_object_elements([],Acc) ->
- lists:reverse(Acc);
-e_object_elements([H|T],Acc) ->
- e_object_elements(T,[e_object_element(H)|Acc]).
-
-e_object_element(Num) when Num < 128 ->
- [Num];
-e_object_element(Num) ->
- [e_o_e(Num bsr 7)|[Num band 2#1111111]].
-e_o_e(Num) when Num < 128 ->
- Num bor 2#10000000;
-e_o_e(Num) ->
- [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_relative_oid(Val) -> CompleteList
-%% encode_relative_oid({Name,Val}) -> CompleteList
-encode_relative_oid(Val) when is_tuple(Val) ->
- encode_relative_oid(tuple_to_list(Val));
-encode_relative_oid(Val) when is_list(Val) ->
- Octets = list_to_binary([e_object_element(X)||X <- Val]),
- Sz = byte_size(Octets),
- [encode_length(Sz)|octets_to_complete(Sz, Octets)].
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% complete(InList) -> ByteList
%% Takes a coded list with bits and bytes and converts it to a list of bytes
%% Should be applied as the last step at encode of a complete ASN.1 type
%%
-complete(L) ->
- case asn1rt_nif:encode_per_complete(L) of
+complete(L0) ->
+ L = complete(L0, []),
+ case list_to_bitstring(L) of
<<>> -> <<0>>;
Bin -> Bin
end.
-octets_to_complete(Len,Val) when Len < 256 ->
- [20,Len,Val];
-octets_to_complete(Len,Val) ->
- [21,<<Len:16>>,Val].
-
-octets_unused_to_complete(Unused,Len,Val) when Len < 256 ->
- [30,Unused,Len,Val];
-octets_unused_to_complete(Unused,Len,Val) ->
- [31,Unused,<<Len:16>>,Val].
+complete([], []) ->
+ [];
+complete([], [H|More]) ->
+ complete(H, More);
+complete([align|T], More) ->
+ complete(T, More);
+complete([[]|T], More) ->
+ complete(T, More);
+complete([[_|_]=H], More) ->
+ complete(H, More);
+complete([[_|_]=H|T], More) ->
+ complete(H, [T|More]);
+complete([H|T], More) when is_integer(H); is_binary(H) ->
+ [H|complete(T, More)];
+complete([H|T], More) ->
+ [H|complete(T, bit_size(H), More)];
+complete(Bin, More) when is_binary(Bin) ->
+ [Bin|complete([], More)];
+complete(Bin, More) ->
+ [Bin|complete([], bit_size(Bin), More)].
+
+complete([], Bits, []) ->
+ case Bits band 7 of
+ 0 -> [];
+ N -> [<<0:(8-N)>>]
+ end;
+complete([], Bits, [H|More]) ->
+ complete(H, Bits, More);
+complete([align|T], Bits, More) ->
+ case Bits band 7 of
+ 0 -> complete(T, More);
+ 1 -> [<<0:7>>|complete(T, More)];
+ 2 -> [<<0:6>>|complete(T, More)];
+ 3 -> [<<0:5>>|complete(T, More)];
+ 4 -> [<<0:4>>|complete(T, More)];
+ 5 -> [<<0:3>>|complete(T, More)];
+ 6 -> [<<0:2>>|complete(T, More)];
+ 7 -> [<<0:1>>|complete(T, More)]
+ end;
+complete([[]|T], Bits, More) ->
+ complete(T, Bits, More);
+complete([[_|_]=H], Bits, More) ->
+ complete(H, Bits, More);
+complete([[_|_]=H|T], Bits, More) ->
+ complete(H, Bits, [T|More]);
+complete([H|T], Bits, More) when is_integer(H);
+ is_binary(H) ->
+ [H|complete(T, Bits, More)];
+complete([H|T], Bits, More) ->
+ [H|complete(T, Bits+bit_size(H), More)];
+complete(Bin, Bits, More) when is_binary(Bin) ->
+ [Bin|complete([], Bits, More)];
+complete(Bin, Bits, More) ->
+ [Bin|complete([], Bits+bit_size(Bin), More)].
diff --git a/lib/asn1/src/asn1rtt_per_common.erl b/lib/asn1/src/asn1rtt_per_common.erl
index e7edc2b65f..9e9fd87ec3 100644
--- a/lib/asn1/src/asn1rtt_per_common.erl
+++ b/lib/asn1/src/asn1rtt_per_common.erl
@@ -28,7 +28,16 @@
decode_chars/2,decode_chars/3,
decode_chars_16bit/1,
decode_big_chars/2,
- decode_oid/1,decode_relative_oid/1]).
+ decode_oid/1,decode_relative_oid/1,
+ encode_chars/2,encode_chars/3,
+ encode_chars_16bit/1,encode_big_chars/1,
+ encode_fragmented/2,
+ encode_oid/1,encode_relative_oid/1,
+ encode_unconstrained_number/1,
+ bitstring_from_positions/1,bitstring_from_positions/2,
+ to_bitstring/1,to_bitstring/2,
+ to_named_bitstring/1,to_named_bitstring/2,
+ extension_bitmap/3]).
-define('16K',16384).
@@ -90,6 +99,182 @@ decode_oid(Octets) ->
decode_relative_oid(Octets) ->
list_to_tuple(dec_subidentifiers(Octets, 0, [])).
+encode_chars(Val, NumBits) ->
+ << <<C:NumBits>> || C <- Val >>.
+
+encode_chars(Val, NumBits, {Lb,Tab}) ->
+ << <<(enc_char(C, Lb, Tab)):NumBits>> || C <- Val >>.
+
+encode_chars_16bit(Val) ->
+ L = [case C of
+ {0,0,A,B} -> [A,B];
+ C when is_integer(C) -> [0,C]
+ end || C <- Val],
+ iolist_to_binary(L).
+
+encode_big_chars(Val) ->
+ L = [case C of
+ {_,_,_,_} -> tuple_to_list(C);
+ C when is_integer(C) -> [<<0,0,0>>,C]
+ end || C <- Val],
+ iolist_to_binary(L).
+
+encode_fragmented(Bin, Unit) ->
+ encode_fragmented_1(Bin, Unit, 4).
+
+encode_oid(Val) when is_tuple(Val) ->
+ encode_oid(tuple_to_list(Val));
+encode_oid(Val) ->
+ iolist_to_binary(e_object_identifier(Val)).
+
+encode_relative_oid(Val) when is_tuple(Val) ->
+ encode_relative_oid(tuple_to_list(Val));
+encode_relative_oid(Val) when is_list(Val) ->
+ list_to_binary([e_object_element(X)||X <- Val]).
+
+encode_unconstrained_number(Val) when Val >= 0 ->
+ if
+ Val < 16#80 ->
+ [1,Val];
+ Val < 16#100 ->
+ [<<2,0>>,Val];
+ true ->
+ case binary:encode_unsigned(Val) of
+ <<0:1,_/bitstring>>=Bin ->
+ case byte_size(Bin) of
+ Sz when Sz < 128 ->
+ [Sz,Bin];
+ Sz when Sz < 16384 ->
+ [<<2:2,Sz:14>>,Bin]
+ end;
+ <<1:1,_/bitstring>>=Bin ->
+ case byte_size(Bin)+1 of
+ Sz when Sz < 128 ->
+ [Sz,0,Bin];
+ Sz when Sz < 16384 ->
+ [<<2:2,Sz:14,0:8>>,Bin]
+ end
+ end
+ end;
+encode_unconstrained_number(Val) ->
+ Oct = enint(Val, []),
+ Len = length(Oct),
+ if
+ Len < 128 ->
+ [Len|Oct];
+ Len < 16384 ->
+ [<<2:2,Len:14>>|Oct]
+ end.
+
+%% bitstring_from_positions([Position]) -> BitString
+%% Given an unsorted list of bit positions (0..MAX), construct
+%% a BIT STRING. The rightmost bit will always be a one.
+
+bitstring_from_positions([]) -> <<>>;
+bitstring_from_positions([_|_]=L0) ->
+ L1 = lists:sort(L0),
+ L = diff(L1, -1),
+ << <<1:(N+0)>> || N <- L >>.
+
+%% bitstring_from_positions([Position], Lb) -> BitString
+%% Given an unsorted list of bit positions (0..MAX) and a lower bound
+%% for the number of bits, construct BIT STRING (zero-padded on the
+%% right side if needed).
+
+bitstring_from_positions(L0, Lb) ->
+ L1 = lists:sort(L0),
+ L = diff(L1, -1, Lb-1),
+ << <<B:(N+0)>> || {B,N} <- L >>.
+
+%% to_bitstring(Val) -> BitString
+%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer
+%% Given one of the possible representations for a BIT STRING,
+%% return a bitstring (without adding or removing any zero bits
+%% at the right end).
+
+to_bitstring({0,Bs}) when is_binary(Bs) ->
+ Bs;
+to_bitstring({Unused,Bs0}) when is_binary(Bs0) ->
+ Sz = bit_size(Bs0) - Unused,
+ <<Bs:Sz/bits,_/bits>> = Bs0,
+ Bs;
+to_bitstring(Bs) when is_bitstring(Bs) ->
+ Bs;
+to_bitstring(Int) when is_integer(Int), Int >= 0 ->
+ L = int_to_bitlist(Int),
+ << <<B:1>> || B <- L >>;
+to_bitstring(L) when is_list(L) ->
+ << <<B:1>> || B <- L >>.
+
+%% to_bitstring(Val, Lb) -> BitString
+%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer
+%% Lb = Integer
+%% Given one of the possible representations for a BIT STRING
+%% and the lower bound for the number of bits,
+%% return a bitstring at least Lb bits long (padded with zeroes
+%% if needed).
+
+to_bitstring({0,Bs}, Lb) when is_binary(Bs) ->
+ case bit_size(Bs) of
+ Sz when Sz < Lb ->
+ <<Bs/bits,0:(Lb-Sz)>>;
+ _ ->
+ Bs
+ end;
+to_bitstring({Unused,Bs0}, Lb) when is_binary(Bs0) ->
+ Sz = bit_size(Bs0) - Unused,
+ if
+ Sz < Lb ->
+ <<Bs0:Sz/bits,0:(Lb-Sz)>>;
+ true ->
+ <<Bs:Sz/bits,_/bits>> = Bs0,
+ Bs
+ end;
+to_bitstring(Bs, Lb) when is_bitstring(Bs) ->
+ adjust_size(Bs, Lb);
+to_bitstring(Int, Lb) when is_integer(Int), Int >= 0 ->
+ L = int_to_bitlist(Int),
+ Bs = << <<B:1>> || B <- L >>,
+ adjust_size(Bs, Lb);
+to_bitstring(L, Lb) when is_list(L) ->
+ Bs = << <<B:1>> || B <- L >>,
+ adjust_size(Bs, Lb).
+
+%% to_named_bitstring(Val) -> BitString
+%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer
+%% Given one of the possible representations for a BIT STRING,
+%% return a bitstring where any trailing zeroes have been stripped.
+
+to_named_bitstring(Val) ->
+ Bs = to_bitstring(Val),
+ bs_drop_trailing_zeroes(Bs).
+
+%% to_named_bitstring(Val, Lb) -> BitString
+%% Val = BitString | {Unused,Binary} | [OneOrZero] | Integer
+%% Lb = Integer
+%% Given one of the possible representations for a BIT STRING
+%% and the lower bound for the number of bits,
+%% return a bitstring that is at least Lb bits long. There will
+%% be zeroes at the right only if needed to reach the lower bound
+%% for the number of bits.
+
+to_named_bitstring({0,Bs}, Lb) when is_binary(Bs) ->
+ adjust_trailing_zeroes(Bs, Lb);
+to_named_bitstring({Unused,Bs0}, Lb) when is_binary(Bs0) ->
+ Sz = bit_size(Bs0) - Unused,
+ <<Bs:Sz/bits,_/bits>> = Bs0,
+ adjust_trailing_zeroes(Bs, Lb);
+to_named_bitstring(Bs, Lb) when is_bitstring(Bs) ->
+ adjust_trailing_zeroes(Bs, Lb);
+to_named_bitstring(Val, Lb) ->
+ %% Obsolete representations: list or integer. Optimize
+ %% for correctness, not speed.
+ adjust_trailing_zeroes(to_bitstring(Val), Lb).
+
+
+extension_bitmap(Val, Pos, Limit) ->
+ extension_bitmap(Val, Pos, Limit, 0).
+
%%%
%%% Internal functions.
%%%
@@ -124,3 +309,149 @@ dec_subidentifiers([H|T], Av, Al) ->
dec_subidentifiers(T, 0, [(Av bsl 7) bor H|Al]);
dec_subidentifiers([], _Av, Al) ->
lists:reverse(Al).
+
+enc_char(C0, Lb, Tab) ->
+ try element(C0-Lb, Tab) of
+ ill ->
+ illegal_char_error();
+ C ->
+ C
+ catch
+ error:badarg ->
+ illegal_char_error()
+ end.
+
+illegal_char_error() ->
+ error({error,{asn1,"value forbidden by FROM constraint"}}).
+
+encode_fragmented_1(Bin, Unit, N) ->
+ SegSz = Unit * N * ?'16K',
+ case Bin of
+ <<B:SegSz/bitstring,T/bitstring>> ->
+ [<<3:2,N:6>>,B|encode_fragmented_1(T, Unit, N)];
+ _ when N > 1 ->
+ encode_fragmented_1(Bin, Unit, N-1);
+ _ ->
+ case bit_size(Bin) div Unit of
+ Len when Len < 128 ->
+ [Len,Bin];
+ Len when Len < 16384 ->
+ [<<2:2,Len:14>>,Bin]
+ end
+ end.
+
+%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1)
+e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40; E1 =:= 2 ->
+ Head = 40*E1 + E2,
+ e_object_elements([Head|Tail], []);
+e_object_identifier([_,_|_Tail]=Oid) ->
+ exit({error,{asn1,{'illegal_value',Oid}}}).
+
+e_object_elements([], Acc) ->
+ lists:reverse(Acc);
+e_object_elements([H|T], Acc) ->
+ e_object_elements(T, [e_object_element(H)|Acc]).
+
+e_object_element(Num) when Num < 128 ->
+ [Num];
+e_object_element(Num) ->
+ [e_o_e(Num bsr 7)|[Num band 2#1111111]].
+
+e_o_e(Num) when Num < 128 ->
+ Num bor 2#10000000;
+e_o_e(Num) ->
+ [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]].
+
+enint(-1, [B1|T]) when B1 > 127 ->
+ [B1|T];
+enint(N, Acc) ->
+ enint(N bsr 8, [N band 16#ff|Acc]).
+
+diff([H|T], Prev) ->
+ [H-Prev|diff(T, H)];
+diff([], _) -> [].
+
+diff([H|T], Prev, Last) ->
+ [{1,H-Prev}|diff(T, H, Last)];
+diff([], Prev, Last) when Last >= Prev ->
+ [{0,Last-Prev}];
+diff([], _, _) -> [].
+
+int_to_bitlist(0) -> [];
+int_to_bitlist(Int) -> [Int band 1|int_to_bitlist(Int bsr 1)].
+
+adjust_size(Bs, Lb) ->
+ case bit_size(Bs) of
+ Sz when Sz < Lb ->
+ <<Bs:Sz/bits,0:(Lb-Sz)>>;
+ _ ->
+ Bs
+ end.
+
+adjust_trailing_zeroes(Bs0, Lb) ->
+ case bit_size(Bs0) of
+ Sz when Sz < Lb ->
+ %% Too short - pad with zeroes.
+ <<Bs0:Sz/bits,0:(Lb-Sz)>>;
+ Lb ->
+ %% Exactly the right size - nothing to do.
+ Bs0;
+ _ ->
+ %% Longer than the lower bound - drop trailing zeroes.
+ <<_:Lb/bits,Tail/bits>> = Bs0,
+ Sz = Lb + bit_size(bs_drop_trailing_zeroes(Tail)),
+ <<Bs:Sz/bits,_/bits>> = Bs0,
+ Bs
+ end.
+
+bs_drop_trailing_zeroes(Bs) ->
+ bs_drop_trailing_zeroes(Bs, bit_size(Bs)).
+
+bs_drop_trailing_zeroes(Bs0, Sz0) when Sz0 < 8 ->
+ <<Byte:Sz0>> = Bs0,
+ Sz = Sz0 - ntz(Byte),
+ <<Bs:Sz/bits,_/bits>> = Bs0,
+ Bs;
+bs_drop_trailing_zeroes(Bs0, Sz0) ->
+ Sz1 = Sz0 - 8,
+ <<Bs1:Sz1/bits,Byte:8>> = Bs0,
+ case ntz(Byte) of
+ 8 ->
+ bs_drop_trailing_zeroes(Bs1, Sz1);
+ Ntz ->
+ Sz = Sz0 - Ntz,
+ <<Bs:Sz/bits,_:Ntz/bits>> = Bs0,
+ Bs
+ end.
+
+%% ntz(Byte) -> Number of trailing zeroes.
+ntz(Byte) ->
+ %% The table was calculated like this:
+ %% NTZ = fun (B, N, NTZ) when B band 1 =:= 0 -> NTZ(B bsr 1, N+1, NTZ); (_, N, _) -> N end.
+ %% io:format("~w\n", [list_to_tuple([NTZ(B+256, 0, NTZ) || B <- lists:seq(0, 255)])]).
+ T = {8,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 7,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
+ 4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0},
+ element(Byte+1, T).
+
+extension_bitmap(_Val, Pos, Limit, Acc) when Pos >= Limit ->
+ Acc;
+extension_bitmap(Val, Pos, Limit, Acc) ->
+ Bit = case element(Pos, Val) of
+ asn1_NOVALUE -> 0;
+ _ -> 1
+ end,
+ extension_bitmap(Val, Pos+1, Limit, (Acc bsl 1) bor Bit).
diff --git a/lib/asn1/src/asn1rtt_real_common.erl b/lib/asn1/src/asn1rtt_real_common.erl
index 22a1f4c4dd..12ca165ecd 100644
--- a/lib/asn1/src/asn1rtt_real_common.erl
+++ b/lib/asn1/src/asn1rtt_real_common.erl
@@ -105,8 +105,7 @@ encode_real(_C, {Mantissa, Base, Exponent}) when Base =:= 2 ->
true -> list_to_binary(real_mininum_octets(-(Man))) % signbit keeps track of sign
end,
%% ok = io:format("LenMask: ~w EOctets: ~w~nFirstOctet: ~w OctMantissa: ~w OctExpLen: ~w~n", [LenMask, EOctets, FirstOctet, OctMantissa, OctExpLen]),
- Bin = <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>,
- {Bin, size(Bin)};
+ <<FirstOctet/binary, EOctets/binary, OctMantissa/binary>>;
encode_real(C, {Mantissa,Base,Exponent})
when Base =:= 10, is_integer(Mantissa), is_integer(Exponent) ->
%% always encode as NR3 due to DER on the format
@@ -176,8 +175,7 @@ encode_real_as_string(_C, Mantissa, Exponent)
end,
ManBin = list_to_binary(TruncMant),
NR3 = 3,
- {<<NR3,ManBin/binary,$.,ExpBin/binary>>,
- 2 + byte_size(ManBin) + byte_size(ExpBin)}.
+ <<NR3,ManBin/binary,$.,ExpBin/binary>>.
remove_trailing_zeros(IntStr) ->
case lists:dropwhile(fun($0)-> true;
diff --git a/lib/asn1/src/asn1rtt_uper.erl b/lib/asn1/src/asn1rtt_uper.erl
index a5035c6660..68a89c70e1 100644
--- a/lib/asn1/src/asn1rtt_uper.erl
+++ b/lib/asn1/src/asn1rtt_uper.erl
@@ -19,95 +19,8 @@
%%
-module(asn1rtt_uper).
--export([setext/1, fixoptionals/3,
- fixextensions/2,
- skipextensions/3]).
--export([set_choice/3, encode_integer/2, encode_integer/3]).
--export([encode_small_number/1, encode_constrained_number/2,
- encode_boolean/1,
- encode_length/1, encode_length/2,
- encode_bit_string/3]).
--export([encode_octet_string/1,encode_octet_string/2,
- encode_relative_oid/1,
- encode_object_identifier/1,
- complete/1, complete_NFP/1]).
-
- -export([encode_open_type/1]).
-
- -export([encode_UniversalString/3,
- encode_PrintableString/3,
- encode_GeneralString/2,
- encode_GraphicString/2,
- encode_TeletexString/2,
- encode_VideotexString/2,
- encode_VisibleString/3,
- encode_UTF8String/1,
- encode_BMPString/3,
- encode_IA5String/3,
- encode_NumericString/3,
- encode_ObjectDescriptor/2
- ]).
-
--define('16K',16384).
--define('32K',32768).
--define('64K',65536).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% setext(true|false) -> CompleteList
-%%
-
-setext(false) ->
- <<0:1>>;
-setext(true) ->
- <<1:1>>.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% This is the new fixoptionals/3 which is used by the new generates
-%%
-fixoptionals(OptList,OptLength,Val) when is_tuple(Val) ->
- Bits = fixoptionals(OptList,Val,0),
- {Val,<<Bits:OptLength>>};
-
-fixoptionals([],_Val,Acc) ->
- %% Optbits
- Acc;
-fixoptionals([{Pos,DefVal}|Ot],Val,Acc) ->
- case element(Pos,Val) of
- asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1);
- DefVal -> fixoptionals(Ot,Val,Acc bsl 1);
- _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1)
- end;
-fixoptionals([Pos|Ot],Val,Acc) ->
- case element(Pos,Val) of
- asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1);
- asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1);
- _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1)
- end.
-
-
-fixextensions({ext,ExtPos,ExtNum},Val) ->
- case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of
- 0 -> [];
- ExtBits ->
- [encode_small_length(ExtNum),<<ExtBits:ExtNum>>]
- end.
-
-fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos ->
- Acc;
-fixextensions(Pos,ExtPos,Val,Acc) ->
- Bit = case catch(element(Pos+1,Val)) of
- asn1_NOVALUE ->
- 0;
- asn1_NOEXTVALUE ->
- 0;
- {'EXIT',_} ->
- 0;
- _ ->
- 1
- end,
- fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit).
+-export([skipextensions/3]).
+-export([complete/1, complete_NFP/1]).
skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) ->
Prev = Nr - 1,
@@ -122,249 +35,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) -
Bytes0
end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings
-%% Alt = atom()
-%% Altnum = integer() | {integer(),integer()}% number of alternatives
-%% Choices = [atom()] | {[atom()],[atom()]}
-%% When Choices is a tuple the first list is the Rootset and the
-%% second is the Extensions and then Altnum must also be a tuple with the
-%% lengths of the 2 lists
-%%
-set_choice(Alt, {L1,L2}, {Len1,_Len2}) ->
- case set_choice_tag(Alt, L1) of
- N when is_integer(N), Len1 > 1 ->
- [<<0:1>>, % the value is in the root set
- encode_integer([{'ValueRange',{0,Len1-1}}],N)];
- N when is_integer(N) ->
- <<0:1>>; % no encoding if only 0 or 1 alternative
- false ->
- [<<1:1>>, % extension value
- case set_choice_tag(Alt,L2) of
- N2 when is_integer(N2) ->
- encode_small_number(N2);
- false ->
- unknown_choice_alt
- end]
- end;
-set_choice(Alt,L,Len) ->
- case set_choice_tag(Alt,L) of
- N when is_integer(N), Len > 1 ->
- encode_integer([{'ValueRange',{0,Len-1}}],N);
- N when is_integer(N) ->
- []; % no encoding if only 0 or 1 alternative
- false ->
- [unknown_choice_alt]
- end.
-
-set_choice_tag(Alt,Choices) ->
- set_choice_tag(Alt,Choices,0).
-
-set_choice_tag(Alt,[Alt|_Rest],Tag) ->
- Tag;
-set_choice_tag(Alt,[_H|Rest],Tag) ->
- set_choice_tag(Alt,Rest,Tag+1);
-set_choice_tag(_Alt,[],_Tag) ->
- false.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_open_type(Constraint, Value) -> CompleteList
-%% Value = list of bytes of an already encoded value (the list must be flat)
-%% | binary
-%% Contraint = not used in this version
-%%
-encode_open_type(Val) ->
- [encode_length(byte_size(Val)),Val].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_integer(Constraint,Value,NamedNumberList) -> CompleteList
-%% encode_integer(Constraint,Value) -> CompleteList
-%% encode_integer(Constraint,{Name,Value}) -> CompleteList
-%%
-%%
-encode_integer(C, V, NamedNumberList) when is_atom(V) ->
- case lists:keyfind(V, 1, NamedNumberList) of
- {_,NewV} ->
- encode_integer(C, NewV);
- false ->
- exit({error,{asn1,{namednumber,V}}})
- end;
-encode_integer(C, V, _NamedNumberList) when is_integer(V) ->
- encode_integer(C, V).
-
-encode_integer([{Rc,_Ec}],Val) when is_tuple(Rc) ->
- try
- [<<0:1>>,encode_integer([Rc], Val)]
- catch
- _:{error,{asn1,_}} ->
- [<<1:1>>,encode_unconstrained_number(Val)]
- end;
-encode_integer(C, Val) when is_list(C) ->
- case get_constraint(C, 'SingleValue') of
- no ->
- encode_integer1(C,Val);
- V when is_integer(V), V =:= Val ->
- []; % a type restricted to a single value encodes to nothing
- V when is_list(V) ->
- case lists:member(Val,V) of
- true ->
- encode_integer1(C,Val);
- _ ->
- exit({error,{asn1,{illegal_value,Val}}})
- end;
- _ ->
- exit({error,{asn1,{illegal_value,Val}}})
- end.
-
-encode_integer1(C, Val) ->
- case VR = get_constraint(C, 'ValueRange') of
- no ->
- encode_unconstrained_number(Val);
- {Lb,'MAX'} when Lb =< Val ->
- encode_semi_constrained_number(Lb, Val);
- %% positive with range
- {Lb,Ub} when Val >= Lb, Ub >= Val ->
- encode_constrained_number(VR,Val);
- _ ->
- exit({error,{asn1,{illegal_value,VR,Val}}})
- end.
-
-%% X.691:10.6 Encoding of a normally small non-negative whole number
-%% Use this for encoding of CHOICE index if there is an extension marker in
-%% the CHOICE
-encode_small_number(Val) when Val < 64 ->
- <<Val:7>>;
-encode_small_number(Val) ->
- [<<1:1>>|encode_semi_constrained_number(0, Val)].
-
-%% X.691:10.7 Encoding of a semi-constrained whole number
-encode_semi_constrained_number(Lb, Val) ->
- %% encoding in minimum number of octets preceeded by a length
- Val2 = Val - Lb,
- Bin = eint_bin_positive(Val2),
- Size = byte_size(Bin),
- if
- Size < 128 ->
- [<<Size>>,Bin];
- Size < 16384 ->
- [<<2:2,Size:14>>,Bin];
- true ->
- [encode_length(Size),Bin]
- end.
-
-encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val ->
- Range = Ub - Lb + 1,
- Val2 = Val - Lb,
- NumBits = num_bits(Range),
- <<Val2:NumBits>>;
-encode_constrained_number(Range,Val) ->
- exit({error,{asn1,{integer_range,Range,value,Val}}}).
-
-%% X.691:10.8 Encoding of an unconstrained whole number
-
-encode_unconstrained_number(Val) when Val >= 0 ->
- Oct = eint_bin_2Cs(Val),
- Len = byte_size(Oct),
- if
- Len < 128 ->
- [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster
- Len < 16384 ->
- [<<2:2,Len:14>>,Oct];
- true ->
- [encode_length(Len),<<Len:16>>,Oct]
- end;
-encode_unconstrained_number(Val) -> % negative
- Oct = enint(Val,[]),
- Len = byte_size(Oct),
- if
- Len < 128 ->
- [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster
- Len < 16384 ->
- [<<2:2,Len:14>>,Oct];
- true ->
- [encode_length(Len),Oct]
- end.
-
-
-eint_bin_2Cs(Int) ->
- case eint_bin_positive(Int) of
- <<B,_/binary>> = Bin when B > 16#7f ->
- <<0,Bin/binary>>;
- Bin -> Bin
- end.
-
-%% returns the integer as a binary
-eint_bin_positive(Val) when Val < 16#100 ->
- <<Val>>;
-eint_bin_positive(Val) when Val < 16#10000 ->
- <<Val:16>>;
-eint_bin_positive(Val) when Val < 16#1000000 ->
- <<Val:24>>;
-eint_bin_positive(Val) when Val < 16#100000000 ->
- <<Val:32>>;
-eint_bin_positive(Val) ->
- list_to_binary([eint_bin_positive2(Val bsr 32),<<Val:32>>]).
-
-eint_bin_positive2(Val) when Val < 16#100 ->
- <<Val>>;
-eint_bin_positive2(Val) when Val < 16#10000 ->
- <<Val:16>>;
-eint_bin_positive2(Val) when Val < 16#1000000 ->
- <<Val:24>>;
-eint_bin_positive2(Val) when Val < 16#100000000 ->
- <<Val:32>>;
-eint_bin_positive2(Val) ->
- [eint_bin_positive2(Val bsr 32),<<Val:32>>].
-
-
-
-
-enint(-1, [B1|T]) when B1 > 127 ->
- list_to_binary([B1|T]);
-enint(N, Acc) ->
- enint(N bsr 8, [N band 16#ff|Acc]).
-
-
-%% X.691:10.9 Encoding of a length determinant
-%%encode_small_length(undefined,Len) -> % null means no UpperBound
-%% encode_small_number(Len).
-
-%% X.691:10.9.3.5
-%% X.691:10.9.3.7
-encode_length(Len) -> % un-constrained
- if
- Len < 128 ->
- <<Len>>;
- Len < 16384 ->
- <<2:2,Len:14>>;
- true -> % should be able to endode length >= 16384
- error({error,{asn1,{encode_length,{nyi,above_16k}}}})
- end.
-
-encode_length({C,[]}, Len) ->
- case C of
- {Lb,Ub}=Vr when Lb =< Len, Len =< Ub ->
- [<<0:1>>|encode_constrained_number(Vr, Len)];
- _ ->
- [<<1:1>>|encode_length(Len)]
- end;
-encode_length(Len, Len) ->
- [];
-encode_length(Vr, Len) ->
- encode_constrained_number(Vr, Len).
-
-
-%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension
-%% additions in a sequence or set
-encode_small_length(Len) when Len =< 64 ->
- <<(Len-1):7>>;
-encode_small_length(Len) ->
- [<<1:1>>,encode_length(Len)].
-
-
%% un-constrained
decode_length(<<0:1,Oct:7,Rest/bitstring>>) ->
{Oct,Rest};
@@ -373,575 +43,20 @@ decode_length(<<2:2,Val:14,Rest/bitstring>>) ->
decode_length(<<3:2,_:14,_Rest/bitstring>>) ->
exit({error,{asn1,{decode_length,{nyi,above_16k}}}}).
- % X.691:11
-encode_boolean(true) ->
- <<1:1>>;
-encode_boolean(false) ->
- <<0:1>>;
-encode_boolean(Val) ->
- exit({error,{asn1,{encode_boolean,Val}}}).
-
-
-%%============================================================================
-%%============================================================================
-%% Bitstring value, ITU_T X.690 Chapter 8.5
-%%============================================================================
-%%============================================================================
-
-%%============================================================================
-%% encode bitstring value
-%%============================================================================
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% bitstring NamedBitList
-%% Val can be of:
-%% - [identifiers] where only named identifers are set to one,
-%% the Constraint must then have some information of the
-%% bitlength.
-%% - [list of ones and zeroes] all bits
-%% - integer value representing the bitlist
-%% C is constraint Len, only valid when identifiers are present
-
-
-%% when the value is a list of {Unused,BinBits}, where
-%% Unused = integer(),
-%% BinBits = binary().
-
-encode_bit_string(C, Bits, NamedBitList) when is_bitstring(Bits) ->
- PadLen = (8 - (bit_size(Bits) band 7)) band 7,
- Compact = {PadLen,<<Bits/bitstring,0:PadLen>>},
- encode_bit_string(C, Compact, NamedBitList);
-encode_bit_string(C, {Unused,BinBits}=Bin, NamedBitList)
- when is_integer(Unused), is_binary(BinBits) ->
- encode_bin_bit_string(C, Bin, NamedBitList);
-
-encode_bit_string(C, BitListVal, NamedBitList) ->
- encode_bit_string1(C, BitListVal, NamedBitList).
-
-%% when the value is a list of named bits
-encode_bit_string1(C, [FirstVal|_RestVal]=LoNB, NamedBitList)
- when is_atom(FirstVal) ->
- ToSetPos = get_all_bitposes(LoNB, NamedBitList, []),
- BitList = make_and_set_list(ToSetPos, 0),
- encode_bit_string1(C, BitList, NamedBitList);
-encode_bit_string1(C, [{bit,_No}|_RestVal]=BL, NamedBitList) ->
- ToSetPos = get_all_bitposes(BL, NamedBitList, []),
- BitList = make_and_set_list(ToSetPos, 0),
- encode_bit_string1(C, BitList, NamedBitList);
-%% when the value is a list of ones and zeroes
-encode_bit_string1(Int, BitListValue, _)
- when is_list(BitListValue), is_integer(Int) ->
- %% The type is constrained by a single value size constraint
- bit_list2bitstr(Int, BitListValue);
-encode_bit_string1(no, BitListValue, [])
- when is_list(BitListValue) ->
- Len = length(BitListValue),
- [encode_length(Len),bit_list2bitstr(Len,BitListValue)];
-encode_bit_string1(C, BitListValue,[])
- when is_list(BitListValue) ->
- Len = length(BitListValue),
- [encode_length(C, Len),bit_list2bitstr(Len,BitListValue)];
-encode_bit_string1(no, BitListValue,_NamedBitList)
- when is_list(BitListValue) ->
- NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end,
- lists:reverse(BitListValue))),
- Len = length(NewBitLVal),
- [encode_length(Len),bit_list2bitstr(Len,NewBitLVal)];
-encode_bit_string1(C, BitListValue, _NamedBitList)
- when is_list(BitListValue) ->% C = {_,'MAX'}
- NewBitStr = bitstr_trailing_zeros(BitListValue, C),
- [encode_length(C, bit_size(NewBitStr)),NewBitStr];
-
-
-%% when the value is an integer
-encode_bit_string1(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)->
- BitList = int_to_bitlist(IntegerVal),
- encode_bit_string1(C, BitList, NamedBitList).
-
-bit_list2bitstr(Len,BitListValue) ->
- case length(BitListValue) of
- Len ->
- << <<B:1>> || B <- BitListValue>>;
- L when L > Len -> % truncate
- <<(<< <<B:1>> || B <- BitListValue>>):Len/bitstring>>;
- L -> % Len > L -> pad
- <<(<< <<B:1>> || B <- BitListValue>>)/bitstring,0:(Len-L)>>
- end.
-
-adjust_trailing_zeros(Len, Bin) when Len =:= bit_size(Bin) ->
- Bin;
-adjust_trailing_zeros(Len, Bin) when Len > bit_size(Bin) ->
- <<Bin/bitstring,0:(Len-bit_size(Bin))>>;
-adjust_trailing_zeros(Len,Bin) ->
- <<Bin:Len/bitstring>>.
-
-bitstr_trailing_zeros(BitList, C) when is_integer(C) ->
- bitstr_trailing_zeros1(BitList, C, C);
-bitstr_trailing_zeros(BitList, {Lb,Ub}) when is_integer(Lb) ->
- bitstr_trailing_zeros1(BitList,Lb,Ub);
-bitstr_trailing_zeros(BitList, {{Lb,Ub},_}) when is_integer(Lb) ->
- bitstr_trailing_zeros1(BitList, Lb, Ub);
-bitstr_trailing_zeros(BitList, _) ->
- bit_list2bitstr(length(BitList), BitList).
-
-bitstr_trailing_zeros1(BitList, Lb, Ub) ->
- case length(BitList) of
- Lb -> bit_list2bitstr(Lb, BitList);
- B when B < Lb -> bit_list2bitstr(Lb, BitList);
- D -> F = fun(L,LB,LB,_,_)->bit_list2bitstr(LB,lists:reverse(L));
- ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun);
- (L,L1,_,UB,_)when L1 =< UB ->
- bit_list2bitstr(L1,lists:reverse(L));
- (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING,
- BitList}}) end,
- F(lists:reverse(BitList),D,Lb,Ub,F)
- end.
-
-%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits.
-%% Unused = integer(),i.e. number unused bits in least sign. byte of
-%% BinBits = binary().
-encode_bin_bit_string(C, {_,BinBits}, _NamedBitList)
- when is_integer(C), C =< 16 ->
- adjust_trailing_zeros(C, BinBits);
-encode_bin_bit_string(C, {_Unused,BinBits}, _NamedBitList)
- when is_integer(C) ->
- adjust_trailing_zeros(C, BinBits);
-encode_bin_bit_string(C, {_,_}=UnusedAndBin, NamedBitList) ->
- %% removes all trailing bits if NamedBitList is not empty
- BitStr = remove_trailing_bin(NamedBitList, UnusedAndBin),
- case C of
- {Lb,Ub} when is_integer(Lb),is_integer(Ub) ->
- [encode_length({Lb,Ub},bit_size(BitStr)),BitStr];
- no ->
- [encode_length(bit_size(BitStr)),BitStr];
- Sc ->
- [encode_length(Sc,bit_size(BitStr)),BitStr]
- end.
-
-
-remove_trailing_bin([], {Unused,Bin}) ->
- BS = bit_size(Bin)-Unused,
- <<BitStr:BS/bitstring,_:Unused>> = Bin,
- BitStr;
-remove_trailing_bin(_NamedNumberList, {_Unused,<<>>}) ->
- <<>>;
-remove_trailing_bin(NamedNumberList, {_Unused,Bin}) ->
- Size = byte_size(Bin)-1,
- <<Bfront:Size/binary, LastByte:8>> = Bin,
-
- %% clear the Unused bits to be sure
- Unused1 = trailingZeroesInNibble(LastByte band 15),
- Unused2 =
- case Unused1 of
- 4 ->
- 4 + trailingZeroesInNibble(LastByte bsr 4);
- _ -> Unused1
- end,
- case Unused2 of
- 8 ->
- remove_trailing_bin(NamedNumberList,{0,Bfront});
- _ ->
- BS = bit_size(Bin) - Unused2,
- <<BitStr:BS/bitstring,_:Unused2>> = Bin,
- BitStr
- end.
-
-trailingZeroesInNibble(0) ->
- 4;
-trailingZeroesInNibble(1) ->
- 0;
-trailingZeroesInNibble(2) ->
- 1;
-trailingZeroesInNibble(3) ->
- 0;
-trailingZeroesInNibble(4) ->
- 2;
-trailingZeroesInNibble(5) ->
- 0;
-trailingZeroesInNibble(6) ->
- 1;
-trailingZeroesInNibble(7) ->
- 0;
-trailingZeroesInNibble(8) ->
- 3;
-trailingZeroesInNibble(9) ->
- 0;
-trailingZeroesInNibble(10) ->
- 1;
-trailingZeroesInNibble(11) ->
- 0;
-trailingZeroesInNibble(12) -> %#1100
- 2;
-trailingZeroesInNibble(13) ->
- 0;
-trailingZeroesInNibble(14) ->
- 1;
-trailingZeroesInNibble(15) ->
- 0.
-
-
-%%%%%%%%%%%%%%%
-%%
-
-int_to_bitlist(Int) when is_integer(Int), Int > 0 ->
- [Int band 1 | int_to_bitlist(Int bsr 1)];
-int_to_bitlist(0) ->
- [].
-
-
-%%%%%%%%%%%%%%%%%%
-%% get_all_bitposes([list of named bits to set], named_bit_db, []) ->
-%% [sorted_list_of_bitpositions_to_set]
-
-get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) ->
- get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]);
-
-get_all_bitposes([Val | Rest], NamedBitList, Ack) ->
- case lists:keyfind(Val, 1, NamedBitList) of
- {_ValName, ValPos} ->
- get_all_bitposes(Rest, NamedBitList, [ValPos | Ack]);
- false ->
- exit({error,{asn1, {bitstring_namedbit, Val}}})
- end;
-get_all_bitposes([], _NamedBitList, Ack) ->
- lists:sort(Ack).
-
-%%%%%%%%%%%%%%%%%%
-%% make_and_set_list([list of positions to set to 1])->
-%% returns list with all in SetPos set.
-%% in positioning in list the first element is 0, the second 1 etc.., but
-%%
-
-make_and_set_list([XPos|SetPos], XPos) ->
- [1 | make_and_set_list(SetPos, XPos + 1)];
-make_and_set_list([Pos|SetPos], XPos) ->
- [0 | make_and_set_list([Pos | SetPos], XPos + 1)];
-make_and_set_list([], _) ->
- [].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% X.691:16
-%% encode_octet_string(Val)
-%% encode_octet_string(Constraint, Val)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-encode_octet_string(Val) ->
- try
- [encode_length(length(Val)),list_to_binary(Val)]
- catch
- error:{error,{asn1,{encode_length,_}}} ->
- encode_fragmented_octet_string(Val)
- end.
-
-encode_octet_string(C, Val) ->
- case C of
- {_,_}=VR ->
- try
- [encode_length(VR, length(Val)),list_to_binary(Val)]
- catch
- error:{error,{asn1,{encode_length,_}}} ->
- encode_fragmented_octet_string(Val)
- end;
- Sv when is_integer(Sv), Sv =:= length(Val) -> % fixed length
- list_to_binary(Val)
- end.
-
-
-encode_fragmented_octet_string(Val) ->
- Bin = list_to_binary(Val),
- efos_1(Bin).
-
-efos_1(<<B:16#10000/binary,T/binary>>) ->
- [<<3:2,4:6>>,B|efos_1(T)];
-efos_1(<<B:16#C000/binary,T/binary>>) ->
- [<<3:2,3:6>>,B|efos_1(T)];
-efos_1(<<B:16#8000/binary,T/binary>>) ->
- [<<3:2,2:6>>,B|efos_1(T)];
-efos_1(<<B:16#4000/binary,T/binary>>) ->
- [<<3:2,1:6>>,B|efos_1(T)];
-efos_1(<<B/bitstring>>) ->
- Len = byte_size(B),
- [encode_length(Len),B].
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Restricted char string types
-%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString)
-%% X.691:26 and X.680:34-36
-%%encode_restricted_string('BMPString',Constraints,Extension,Val)
-
-
-encode_restricted_string(Val) when is_list(Val)->
- [encode_length(length(Val)),list_to_binary(Val)].
-
-encode_known_multiplier_string(StringType, C, Pa, Val) ->
- Result = chars_encode(Pa, StringType, Val),
- case C of
- Ub when is_integer(Ub) ->
- Result;
- {_,_}=Range ->
- [encode_length(Range, length(Val)),Result];
- no ->
- [encode_length(length(Val)),Result]
- end.
-
-encode_NumericString(C, Pa, Val) ->
- encode_known_multiplier_string('NumericString', C, Pa, Val).
-
-encode_PrintableString(C, Pa, Val) ->
- encode_known_multiplier_string('PrintableString', C, Pa, Val).
-
-encode_VisibleString(C, Pa, Val) -> % equivalent with ISO646String
- encode_known_multiplier_string('VisibleString', C, Pa, Val).
-
-encode_IA5String(C, Pa, Val) ->
- encode_known_multiplier_string('IA5String', C, Pa, Val).
-
-encode_BMPString(C, Pa, Val) ->
- encode_known_multiplier_string('BMPString', C, Pa, Val).
-
-encode_UniversalString(C, Pa, Val) ->
- encode_known_multiplier_string('UniversalString', C, Pa, Val).
-
-
-%% end of known-multiplier strings for which PER visible constraints are
-%% applied
-
-encode_GeneralString(_C,Val) ->
- encode_restricted_string(Val).
-
-encode_GraphicString(_C,Val) ->
- encode_restricted_string(Val).
-
-encode_ObjectDescriptor(_C,Val) ->
- encode_restricted_string(Val).
-
-encode_TeletexString(_C,Val) -> % equivalent with T61String
- encode_restricted_string(Val).
-
-encode_VideotexString(_C,Val) ->
- encode_restricted_string(Val).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% chars_encode(C,StringType,Value) -> ValueList
-%%
-%% encodes chars according to the per rules taking the constraint PermittedAlphabet
-%% into account.
-%% This function does only encode the value part and NOT the length
-
-chars_encode(Pa, StringType, Value) ->
- case {StringType,Pa} of
- {'UniversalString',{_,_Sv}} ->
- exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}});
- {'BMPString',{_,_Sv}} ->
- exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}});
- _ ->
- {NumBits,CharOutTab} = {get_NumBits(Pa, StringType),
- get_CharOutTab(Pa, StringType)},
- chars_encode2(Value,NumBits,CharOutTab)
- end.
-
-chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min ->
- [<<(H-Min):NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})];
-chars_encode2([H|T],NumBits,{Min,Max,Tab}) when H =< Max, H >= Min ->
- Ch = exit_if_false(H,element(H-Min+1,Tab)),
- [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,Tab})];
-chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) ->
- %% no value range check here (ought to be, but very expensive)
- Ch = ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,
- [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})];
-chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) ->
- %% no value range check here (ought to be, but very expensive)
- Ch = exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)),
- [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})];
-chars_encode2([H|_T],_,{_,_,_}) ->
- exit({error,{asn1,{illegal_char_value,H}}});
-chars_encode2([],_,_) ->
- [].
-
-exit_if_false(V,false)->
- exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}});
-exit_if_false(_,V) ->V.
-
-
-get_NumBits(Pa, StringType) ->
- case Pa of
- {'SingleValue',Sv} ->
- charbits(length(Sv));
- no ->
- case StringType of
- 'IA5String' ->
- charbits(128); % 16#00..16#7F
- 'VisibleString' ->
- charbits(95); % 16#20..16#7E
- 'PrintableString' ->
- charbits(74); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z
- 'NumericString' ->
- charbits(11); % $ ,"0123456789"
- 'UniversalString' ->
- 32;
- 'BMPString' ->
- 16
- end
- end.
-
-get_CharOutTab(Pa, StringType) ->
- case Pa of
- {'SingleValue',Sv} ->
- get_CharTab2(Pa, StringType, hd(Sv), lists:max(Sv), Sv);
- no ->
- case StringType of
- 'IA5String' ->
- {0,16#7F,notab};
- 'VisibleString' ->
- get_CharTab2(Pa, StringType, 16#20, 16#7F, notab);
- 'PrintableString' ->
- Chars = lists:sort(
- " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"),
- get_CharTab2(Pa, StringType, hd(Chars),
- lists:max(Chars), Chars);
- 'NumericString' ->
- get_CharTab2(Pa, StringType, 16#20, $9, " 0123456789");
- 'UniversalString' ->
- {0,16#FFFFFFFF,notab};
- 'BMPString' ->
- {0,16#FFFF,notab}
- end
- end.
-
-get_CharTab2(C,StringType,Min,Max,Chars) ->
- BitValMax = (1 bsl get_NumBits(C,StringType))-1,
- if
- Max =< BitValMax ->
- {0,Max,notab};
- true ->
- {Min,Max,create_char_tab(Min,Chars)}
- end.
-
-create_char_tab(Min,L) ->
- list_to_tuple(create_char_tab(Min,L,0)).
-create_char_tab(Min,[Min|T],V) ->
- [V|create_char_tab(Min+1,T,V+1)];
-create_char_tab(_Min,[],_V) ->
- [];
-create_char_tab(Min,L,V) ->
- [false|create_char_tab(Min+1,L,V)].
-
-%% See Table 20.3 in Dubuisson
-charbits(NumOfChars) when NumOfChars =< 2 -> 1;
-charbits(NumOfChars) when NumOfChars =< 4 -> 2;
-charbits(NumOfChars) when NumOfChars =< 8 -> 3;
-charbits(NumOfChars) when NumOfChars =< 16 -> 4;
-charbits(NumOfChars) when NumOfChars =< 32 -> 5;
-charbits(NumOfChars) when NumOfChars =< 64 -> 6;
-charbits(NumOfChars) when NumOfChars =< 128 -> 7;
-charbits(NumOfChars) when NumOfChars =< 256 -> 8;
-charbits(NumOfChars) when NumOfChars =< 512 -> 9;
-charbits(NumOfChars) when NumOfChars =< 1024 -> 10;
-charbits(NumOfChars) when NumOfChars =< 2048 -> 11;
-charbits(NumOfChars) when NumOfChars =< 4096 -> 12;
-charbits(NumOfChars) when NumOfChars =< 8192 -> 13;
-charbits(NumOfChars) when NumOfChars =< 16384 -> 14;
-charbits(NumOfChars) when NumOfChars =< 32768 -> 15;
-charbits(NumOfChars) when NumOfChars =< 65536 -> 16;
-charbits(NumOfChars) when is_integer(NumOfChars) ->
- 16 + charbits1(NumOfChars bsr 16).
-
-charbits1(0) ->
- 0;
-charbits1(NumOfChars) ->
- 1 + charbits1(NumOfChars bsr 1).
-
-
-%% UTF8String
-encode_UTF8String(Val) when is_binary(Val) ->
- [encode_length(byte_size(Val)),Val];
-encode_UTF8String(Val) ->
- Bin = list_to_binary(Val),
- encode_UTF8String(Bin).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_object_identifier(Val) -> CompleteList
-%% encode_object_identifier({Name,Val}) -> CompleteList
-%% Val -> {Int1,Int2,...,IntN} % N >= 2
-%% Name -> atom()
-%% Int1 -> integer(0..2)
-%% Int2 -> integer(0..39) when Int1 (0..1) else integer()
-%% Int3-N -> integer()
-%% CompleteList -> [binary()|bitstring()|list()]
-%%
-encode_object_identifier(Val) ->
- OctetList = e_object_identifier(Val),
- Octets = list_to_binary(OctetList), % performs a flatten at the same time
- [encode_length(byte_size(Octets)),Octets].
-
-%% This code is copied from asn1_encode.erl (BER) and corrected and modified
-
-e_object_identifier({'OBJECT IDENTIFIER',V}) ->
- e_object_identifier(V);
-e_object_identifier(V) when is_tuple(V) ->
- e_object_identifier(tuple_to_list(V));
-
-%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1)
-e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 ->
- Head = 40*E1 + E2, % weird
- e_object_elements([Head|Tail],[]);
-e_object_identifier(Oid=[_,_|_Tail]) ->
- exit({error,{asn1,{'illegal_value',Oid}}}).
-
-e_object_elements([],Acc) ->
- lists:reverse(Acc);
-e_object_elements([H|T],Acc) ->
- e_object_elements(T,[e_object_element(H)|Acc]).
-
-e_object_element(Num) when Num < 128 ->
- [Num];
-e_object_element(Num) ->
- [e_o_e(Num bsr 7)|[Num band 2#1111111]].
-e_o_e(Num) when Num < 128 ->
- Num bor 2#10000000;
-e_o_e(Num) ->
- [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% encode_relative_oid(Val) -> CompleteList
-%% encode_relative_oid({Name,Val}) -> CompleteList
-encode_relative_oid(Val) when is_tuple(Val) ->
- encode_relative_oid(tuple_to_list(Val));
-encode_relative_oid(Val) when is_list(Val) ->
- Octets = list_to_binary([e_object_element(X)||X <- Val]),
- [encode_length(byte_size(Octets)),Octets].
-
-
-get_constraint([{Key,V}],Key) ->
- V;
-get_constraint([],_Key) ->
- no;
-get_constraint(C,Key) ->
- case lists:keyfind(Key, 1, C) of
- false ->
- no;
- {_,V} ->
- V
- end.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% complete(InList) -> ByteList
%% Takes a coded list with bits and bytes and converts it to a list of bytes
%% Should be applied as the last step at encode of a complete ASN.1 type
%%
complete(InList) when is_list(InList) ->
- case complete1(InList) of
+ case list_to_bitstring(InList) of
<<>> ->
<<0>>;
Res ->
- case bit_size(Res) band 7 of
+ Sz = bit_size(Res),
+ case Sz band 7 of
0 -> Res;
- Bits -> <<Res/bitstring,0:(8-Bits)>>
+ Bits -> <<Res:Sz/bitstring,0:(8-Bits)>>
end
end;
complete(Bin) when is_binary(Bin) ->
@@ -950,24 +65,12 @@ complete(Bin) when is_binary(Bin) ->
_ -> Bin
end;
complete(InList) when is_bitstring(InList) ->
- PadLen = 8 - (bit_size(InList) band 7),
- <<InList/bitstring,0:PadLen>>.
-
-complete1(L) when is_list(L) ->
- list_to_bitstring(L).
+ Sz = bit_size(InList),
+ PadLen = 8 - (Sz band 7),
+ <<InList:Sz/bitstring,0:PadLen>>.
%% Special version of complete that does not align the completed message.
complete_NFP(InList) when is_list(InList) ->
list_to_bitstring(InList);
complete_NFP(InList) when is_bitstring(InList) ->
InList.
-
-%% unaligned helpers
-
-%% 10.5.6 NOTE: If "range" satisfies the inequality 2^m < "range" =<
-%% 2^(m+1) then the number of bits = m + 1
-
-num_bits(N) -> num_bits(N, 1, 0).
-
-num_bits(N,T,B) when N =< T -> B;
-num_bits(N,T,B) -> num_bits(N, T bsl 1, B+1).
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 02:24:33 +0000