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/asn1ct_constructed_per.erl576
-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.erl12
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl259
-rw-r--r--lib/asn1/src/asn1ct_gen_per_rt2ct.erl463
-rw-r--r--lib/asn1/src/asn1ct_imm.erl1411
-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_uper.erl900
11 files changed, 2089 insertions, 2750 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/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index f609cf31d0..68edcfd109 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -45,8 +45,6 @@ gen_encode_sequence(Erules,TypeName,D) ->
gen_encode_constructed(Erule,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
- asn1ct_name:new(term),
- asn1ct_name:new(bytes),
{ExtAddGroup,TmpCompList,TableConsInfo} =
case D#type.def of
#'SEQUENCE'{tablecinf=TCI,components=CL,extaddgroup=ExtAddGroup0} ->
@@ -65,50 +63,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 ->
- gen_encode_extaddgroup(CompList),
- 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
@@ -128,12 +112,13 @@ 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,"'(",
- ValueMatch,"),",nl]),
- {AttrN,ObjectEncode};
+ GetEnc = enc_func("getenc_", ObjSetName),
+ ObjSetImm0 = [{apply,{Module,GetEnc},
+ [{expr,ValueMatch}],
+ {var,ObjectEncode}}],
+ {{AttrN,ObjectEncode},ObjSetImm0};
false ->
- false
+ {false,[]}
end;
_ ->
case D#type.tablecinf of
@@ -141,33 +126,25 @@ 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),
+ Imm = ExternalImm ++ ExtImm ++ ObjSetImm ++
+ asn1ct_imm:enc_append([ImmSetExt] ++ ImmOptionals ++ ImmBody),
+ asn1ct_imm:enc_cg(Imm, Aligned),
+ emit([".",nl]).
gen_encode_extaddgroup(CompList) ->
case extgroup_pos_and_length(CompList) of
@@ -468,25 +445,15 @@ emit_opt_or_mand_check(Val,Term) ->
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(Erule, TopType, #type{def={'CHOICE',CompList}}) ->
+ emit(["{ChoiceTag,ChoiceVal} = Val,",nl,
+ ""]),
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),
+ Imm = asn1ct_imm:per_enc_choice('ChoiceTag', Cs, Aligned),
+ asn1ct_imm:enc_cg(Imm, Aligned),
+ emit([".",nl]).
gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:start(),
@@ -503,86 +470,35 @@ gen_decode_choice(Erules,Typename,D) when is_record(D,type) ->
gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) ->
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(["[begin",nl]),
+ 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),
- case asn1ct_gen:type(Conttype) of
- {primitive,bif} ->
- asn1ct_gen_per:gen_encode_prim(Erule, ComponentType, "Comp");
- {constructed,bif} ->
- NewTypename = [Constructed_Suffix|Typename],
- emit(["'enc_",asn1ct_gen:list2name(NewTypename),
- "'(Comp",ObjFun,")"]);
- #'Externaltypereference'{module=Currmod,type=Ename} ->
- emit(["'enc_",Ename,"'(Comp)"]);
- #'Externaltypereference'{module=EMod,type=EType} ->
- emit(["'",EMod,"':'enc_",EType,"'(Comp)"]);
- 'ASN1_OPEN_TYPE' ->
- asn1ct_gen_per:gen_encode_prim(Erule,
- #type{def='ASN1_OPEN_TYPE'},
- "Comp");
- _ ->
- emit(["'enc_",Conttype,"'(Comp)"])
- end,
- emit([nl,
- "end || Comp <- Val]].",nl,nl]).
-
-%% 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]).
+ 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,
+ Imm = asn1ct_imm:per_enc_sof('Val', D#type.constraint, 'Comp', Imm0, Aligned),
+ asn1ct_imm:enc_cg(Imm, Aligned),
+ emit([".",nl,nl]).
gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) ->
asn1ct_name:start(),
@@ -740,27 +656,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
@@ -774,15 +669,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).
%%%%%%%%%%%%%%%%%%%%%%
@@ -844,33 +737,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 ->
@@ -878,70 +770,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, 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, DynamicEnc, Ext),
- emit({nl,"end"}).
-
-gen_enc_component_mandatory(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) ->
- Element = make_element(Pos+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))),
- InnerType = asn1ct_gen:get_inner(Type#type.def),
- emit({nl,"%% attribute number ",Pos," with type ",
- InnerType,nl}),
- gen_enc_line(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext).
-
-gen_enc_line(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext) ->
+gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc) ->
Atype =
case Type of
#type{def=#'ObjectClassFieldType'{type=InnerType}} ->
@@ -949,71 +819,55 @@ gen_enc_line(Erule, TopType, Cname, Type, Element, 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
+ {_LeadingAttrName,Fun} = DynamicEnc,
+ case (Type#type.def)#'ObjectClassFieldType'.fieldname of
+ {Name,RestFieldNames} when is_atom(Name) ->
+ Imm = [{apply,{var,Fun},
+ [Name,{expr,Element},RestFieldNames]}],
+ 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])).
+
+
gen_dec_components_call(Erule, TopType, {Root,ExtList},
DecInfObj, Ext, NumberOfOptionals) ->
gen_dec_components_call(Erule,TopType,{Root,ExtList,[]},
@@ -1437,53 +1291,25 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) ->
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
@@ -1497,16 +1323,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)",
- 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:
@@ -1655,7 +1490,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),
@@ -1722,6 +1557,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 2948269bfc..dbadedb683 100644
--- a/lib/asn1/src/asn1ct_func.erl
+++ b/lib/asn1/src/asn1ct_func.erl
@@ -28,10 +28,18 @@ 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) ->
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl
index 3973664227..2063cb12e5 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,162 +102,87 @@ 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])
+ 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.
-emit_enc_real(Erules, Real) ->
- asn1ct_name:new(tmpval),
- asn1ct_name:new(tmplen),
- emit(["begin",nl,
- {curr,tmpval}," = ",
- {call,real_common,encode_real,[Real]},com,nl,
- {curr,tmplen}," = ",
- {call,erlang,byte_size,[{curr,tmpval}]},com,nl,
- "[",{call,Erules,encode_length,[{curr,tmplen}]},com,nl,
- {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>>.
-
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
%% ------------------------------------------------
@@ -299,18 +224,7 @@ gen_encode_objectfields(Erule, ClassName,
case {get_object_field(Name,ObjectFields),OptOrMand} of
{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,
+ emit(" Val"),
[];
{false,{'DEFAULT',DefaultType}} ->
EmitFuncClause("Val"),
@@ -651,30 +565,13 @@ gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T],
emit({";",nl}),
gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields,
NewNthObj, InternalFunc ++ Acc);
-gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'],
+gen_objset_enc(_, 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]),
@@ -725,20 +622,9 @@ gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName,
emit([indent(9),{asis,Name}," ->",nl,
indent(12),"'",M,"'",":'enc_",T,"'(Val)"]),
{Acc0,0};
- false when Erule =:= uper ->
+ false ->
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,
@@ -1165,6 +1051,3 @@ imm_dec_open_type_1(Type, Aligned) ->
"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 6c0bd95eef..0000000000
--- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl
+++ /dev/null
@@ -1,463 +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}," = ",
- {call,real_common,encode_real,[Real]},com,nl,
- {curr,tmplen}," = ",
- {call,erlang,byte_size,[{curr,tmpval}]},com,nl,
- "[",{call,Erules,encode_length,[{curr,tmplen}]},com,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 a7e62e061b..44282b4b55 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]).
@@ -142,6 +154,246 @@ 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.
@@ -701,6 +953,1165 @@ 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
+ {var,F} ->
+ emit([F,"(",As,")"]);
+ {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
+ [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/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_uper.erl b/lib/asn1/src/asn1rtt_uper.erl
index a08f7028dc..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,562 +43,6 @@ 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
@@ -960,13 +74,3 @@ 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-02 21:20:41 +0000