diff options
author | Björn Gustavsson <[email protected]> | 2013-04-15 18:02:45 +0200 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2013-08-30 10:13:18 +0200 |
commit | eb49ee71f0751cf54bc39f9971f389c92525b0a4 (patch) | |
tree | 0d101faccacba14653cc5472b47fbe510a7a38d6 /lib/asn1/src | |
parent | c6ba0f6aa81c2b9ce9b348106bffb808b385bd18 (diff) | |
download | otp-eb49ee71f0751cf54bc39f9971f389c92525b0a4.tar.gz otp-eb49ee71f0751cf54bc39f9971f389c92525b0a4.tar.bz2 otp-eb49ee71f0751cf54bc39f9971f389c92525b0a4.zip |
PER, UPER: Optimize encoding using an intermediate format
There are some minor incompatibilities for BIT STRING:
{bit,Position} is now only only supported for a named
BIT STRING type.
Values longer than the maximum size for the BIT STRING type
would be truncated silently - they now cause an exception.
Diffstat (limited to 'lib/asn1/src')
-rw-r--r-- | lib/asn1/src/Makefile | 5 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_constructed_per.erl | 576 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_eval_per.funcs | 2 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_eval_uper.funcs | 2 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_func.erl | 12 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen_per.erl | 259 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_gen_per_rt2ct.erl | 463 | ||||
-rw-r--r-- | lib/asn1/src/asn1ct_imm.erl | 1411 | ||||
-rw-r--r-- | lib/asn1/src/asn1rtt_per.erl | 876 | ||||
-rw-r--r-- | lib/asn1/src/asn1rtt_per_common.erl | 333 | ||||
-rw-r--r-- | lib/asn1/src/asn1rtt_uper.erl | 900 |
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). |