diff options
Diffstat (limited to 'lib/asn1/src')
| -rw-r--r-- | lib/asn1/src/asn1ct.erl | 11 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_constructed_per.erl | 114 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_func.erl | 2 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_gen.erl | 24 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_gen_per.erl | 6 | ||||
| -rw-r--r-- | lib/asn1/src/asn1ct_imm.erl | 834 |
6 files changed, 747 insertions, 244 deletions
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index f2ccf5f212..f2e9606ccb 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -333,8 +333,7 @@ print_structured_errors([_|_]=Errors) -> print_structured_errors(_) -> ok. compile1(File, #st{opts=Opts}=St0) -> - verbose("Erlang ASN.1 version ~p, compiling ~p~n", [?vsn,File], Opts), - verbose("Compiler Options: ~p~n", [Opts], Opts), + compiler_verbose(File, Opts), Passes = single_passes(), Base = filename:rootname(filename:basename(File)), OutFile = outfile(Base, "", Opts), @@ -349,8 +348,7 @@ compile1(File, #st{opts=Opts}=St0) -> %% compile_set/3 merges and compiles a number of asn1 modules %% specified in a .set.asn file to one .erl file. compile_set(SetBase, Files, #st{opts=Opts}=St0) -> - verbose("Erlang ASN.1 version ~p compiling ~p ~n", [?vsn,Files], Opts), - verbose("Compiler Options: ~p~n",[Opts], Opts), + compiler_verbose(Files, Opts), OutFile = outfile(SetBase, "", Opts), DbFile = outfile(SetBase, "asn1db", Opts), InputModules = [begin @@ -363,6 +361,11 @@ compile_set(SetBase, Files, #st{opts=Opts}=St0) -> Passes = set_passes(), run_passes(Passes, St). +compiler_verbose(What, Opts) -> + verbose("Erlang ASN.1 compiler ~s\n", [?vsn], Opts), + verbose("Compiling: ~p\n", [What], Opts), + verbose("Options: ~p\n", [Opts], Opts). + %% merge_modules/2 -> returns a module record where the typeorval lists are merged, %% the exports lists are merged, the imports lists are merged when the %% elements come from other modules than the merge set, the tagdefault diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 4672f7edd3..c224f4c9fa 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -79,7 +79,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> [] end, Aligned = is_aligned(Erule), - Value0 = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Value0 = make_var(val), Optionals = optionals(to_textual_order(CompList)), ImmOptionals = [asn1ct_imm:per_enc_optional(Value0, Opt, Aligned) || Opt <- Optionals], @@ -87,7 +87,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> ExtImm = case Ext of {ext,ExtPos,NumExt} when NumExt > 0 -> gen_encode_extaddgroup(CompList), - Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Value = make_var(val), asn1ct_imm:per_enc_extensions(Value, ExtPos, NumExt, Aligned); _ -> @@ -106,19 +106,17 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> c_index=N, usedclassfield=UniqueFieldName, uniqueclassfield=UniqueFieldName, - valueindex=ValueIndex + valueindex=ValueIndex0 } -> %% N is index of attribute that determines constraint {Module,ObjSetName} = ObjectSet, #typedef{typespec=#'ObjectSet'{gen=Gen}} = asn1_db:dbget(Module, ObjSetName), case Gen of true -> - ObjectEncode = - 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), - ObjSetImm0 = [{assign,{var,ObjectEncode},ValueMatch}], - {{AttrN,ObjectEncode},ObjSetImm0}; + ValueIndex = ValueIndex0 ++ [{N+1,top}], + Val = make_var(val), + {ObjSetImm0,Dst} = enc_dig_out_value(ValueIndex, Val), + {{AttrN,Dst},ObjSetImm0}; false -> {false,[]} end; @@ -128,7 +126,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> %% 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",{var,"ObjFun"}},[]}; _ -> {false,[]} end @@ -136,7 +134,7 @@ gen_encode_constructed_imm(Erule, Typename, #type{}=D) -> ImmSetExt = case Ext of {ext,_Pos,NumExt2} when NumExt2 > 0 -> - asn1ct_imm:per_enc_extension_bit('Extensions', Aligned); + asn1ct_imm:per_enc_extension_bit({var,"Extensions"}, Aligned); {ext,_Pos,_} -> asn1ct_imm:per_enc_extension_bit([], Aligned); _ -> @@ -540,7 +538,7 @@ gen_encode_choice_imm(Erule, TopType, #type{def={'CHOICE',CompList}}) -> Aligned = is_aligned(Erule), Cs = gen_enc_choice(Erule, TopType, CompList, Ext), [{assign,{expr,"{ChoiceTag,ChoiceVal}"},"Val"}| - asn1ct_imm:per_enc_choice('ChoiceTag', Cs, Aligned)]. + asn1ct_imm:per_enc_choice({var,"ChoiceTag"}, Cs, Aligned)]. gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:start(), @@ -562,14 +560,14 @@ gen_encode_sof(Erule, Typename, SeqOrSetOf, D) -> gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) -> {_SeqOrSetOf,ComponentType} = D#type.def, Aligned = is_aligned(Erule), - Constructed_Suffix = - asn1ct_gen:constructed_suffix(SeqOrSetOf, - ComponentType#type.def), - Conttype = asn1ct_gen:get_inner(ComponentType#type.def), + CompType = ComponentType#type.def, + Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, CompType), + Conttype = asn1ct_gen:get_inner(CompType), Currmod = get(currmod), Imm0 = case asn1ct_gen:type(Conttype) of {primitive,bif} -> - asn1ct_gen_per:gen_encode_prim_imm('Comp', ComponentType, Aligned); + asn1ct_gen_per:gen_encode_prim_imm({var,"Comp"}, + ComponentType, Aligned); {constructed,bif} -> TypeName = [Constructed_Suffix|Typename], Enc = enc_func(asn1ct_gen:list2name(TypeName)), @@ -577,17 +575,19 @@ gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) -> [{objfun,_}|_] -> [{var,"ObjFun"}]; _ -> [] end, - [{apply,Enc,[{var,"Comp"}|ObjArg]}]; + [{apply,{local,Enc,CompType}, + [{var,"Comp"}|ObjArg]}]; #'Externaltypereference'{module=Currmod,type=Ename} -> - [{apply,enc_func(Ename),[{var,"Comp"}]}]; + [{apply,{local,enc_func(Ename),CompType},[{var,"Comp"}]}]; #'Externaltypereference'{module=EMod,type=Ename} -> - [{apply,{EMod,enc_func(Ename)},[{var,"Comp"}]}]; + [{apply,{EMod,enc_func(Ename),CompType},[{var,"Comp"}]}]; 'ASN1_OPEN_TYPE' -> - asn1ct_gen_per:gen_encode_prim_imm('Comp', + asn1ct_gen_per:gen_encode_prim_imm({var,"Comp"}, #type{def='ASN1_OPEN_TYPE'}, Aligned) end, - asn1ct_imm:per_enc_sof('Val', D#type.constraint, 'Comp', Imm0, Aligned). + asn1ct_imm:per_enc_sof({var,"Val"}, D#type.constraint, 'Comp', + Imm0, Aligned). gen_decode_sof(Erules, Typename, SeqOrSetOf, #type{}=D) -> asn1ct_name:start(), @@ -871,8 +871,8 @@ gen_enc_components_call1(Erule,TopType, CanonicalNum -> CanonicalNum end, - Element0 = make_element(TermNo+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))), - {Imm0,Element} = asn1ct_imm:enc_bind_var(Element0), + Val = make_var(val), + {Imm0,Element} = asn1ct_imm:enc_element(TermNo+1, Val), Imm1 = gen_enc_line_imm(Erule, TopType, Cname, Type, Element, DynamicEnc, Ext), Category = case {Prop,Ext} of {'OPTIONAL',_} -> @@ -967,9 +967,9 @@ gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc) -> CurrMod = get(currmod), case asn1ct_gen:type(Atype) of #'Externaltypereference'{module=CurrMod,type=EType} -> - [{apply,enc_func(EType),[{expr,Element}]}]; + [{apply,{local,enc_func(EType),Atype},[Element]}]; #'Externaltypereference'{module=Mod,type=EType} -> - [{apply,{Mod,enc_func(EType)},[{expr,Element}]}]; + [{apply,{Mod,enc_func(EType),Atype},[Element]}]; {primitive,bif} -> asn1ct_gen_per:gen_encode_prim_imm(Element, Type, Aligned); 'ASN1_OPEN_TYPE' -> @@ -988,9 +988,9 @@ gen_enc_line_imm_1(Erule, TopType, Cname, Type, Element, DynamicEnc) -> Enc = enc_func(asn1ct_gen:list2name(NewTypename)), case {Type#type.tablecinf,DynamicEnc} of {[{objfun,_}|_R],{_,EncFun}} -> - [{apply,Enc,[{expr,Element},{var,EncFun}]}]; + [{apply,{local,Enc,Type},[Element,EncFun]}]; _ -> - [{apply,Enc,[{expr,Element}]}] + [{apply,{local,Enc,Type},[Element]}] end end end. @@ -1014,13 +1014,16 @@ enc_var_type_call(Erule, Name, RestFieldNames, {_,Key,Code} <- ObjSet1], ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]), Key = erlang:md5(term_to_binary({encode,ObjSet,RestFieldNames,Extensible})), + Imm = enc_objset_imm(Erule, Name, ObjSet, RestFieldNames, Extensible), + Lambda = {lambda,[{var,"Val"},{var,"Id"}],Imm}, Gen = fun(_Fd, N) -> - enc_objset(Erule, Name, N, ObjSet, - RestFieldNames, Extensible) + Aligned = is_aligned(Erule), + emit([{asis,N},"(Val, Id) ->",nl]), + asn1ct_imm:enc_cg(Imm, Aligned), + emit([".",nl]) end, Prefix = lists:concat(["enc_os_",Name]), - F = asn1ct_func:call_gen(Prefix, Key, Gen), - [{apply,F,[{var,atom_to_list(Val)},{var,Fun}]}]. + [{call_gen,Prefix,Key,Gen,Lambda,[Val,Fun]}]. fix_object_code(Name, [{Name,B}|_], _ClassFields) -> B; @@ -1042,9 +1045,7 @@ fix_object_code(Name, [], ClassFields) -> end end. - -enc_objset(Erule, Component, Name, ObjSet, RestFieldNames, Extensible) -> - asn1ct_name:start(), +enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) -> Aligned = is_aligned(Erule), E = {error, fun() -> @@ -1053,22 +1054,19 @@ enc_objset(Erule, Component, Name, ObjSet, RestFieldNames, Extensible) -> "{value,Val}," "{unique_name_and_value,'_'}})",nl]) end}, - Imm = [{'cond', - [[{eq,{var,"Id"},Key}| - enc_obj(Erule, Obj, RestFieldNames, Aligned)] || - {Key,Obj} <- ObjSet] ++ - [['_',case Extensible of - false -> E; - true -> {put_bits,{var,"Val"},binary,[1]} - end]]}], - emit([{asis,Name},"(Val, Id) ->",nl]), - asn1ct_imm:enc_cg(Imm, Aligned), - emit([".",nl]). + [{'cond', + [[{eq,{var,"Id"},Key}| + enc_obj(Erule, Obj, RestFieldNames, Aligned)] || + {Key,Obj} <- ObjSet] ++ + [['_',case Extensible of + false -> E; + true -> {put_bits,{var,"Val"},binary,[1]} + end]]}]. enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> case Obj of #typedef{name={primitive,bif},typespec=Def} -> - asn1ct_gen_per:gen_encode_prim_imm('Val', Def, Aligned); + asn1ct_gen_per:gen_encode_prim_imm({var,"Val"}, Def, Aligned); #typedef{name={constructed,bif},typespec=Def} -> InnerType = asn1ct_gen:get_inner(Def#type.def), case InnerType of @@ -1084,7 +1082,7 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> gen_encode_sof_imm(Erule, name, InnerType, Def) end; #typedef{name=Type} -> - [{apply,enc_func(Type),[{var,"Val"}]}]; + [{apply,{local,enc_func(Type),Type},[{var,"Val"}]}]; #'Externalvaluereference'{module=Mod,value=Value} -> case asn1_db:dbget(Mod, Value) of #typedef{typespec=#'Object'{def=Def}} -> @@ -1097,9 +1095,9 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> Func = enc_func(Type), case get(currmod) of Mod -> - [{apply,Func,[{var,"Val"}]}]; + [{apply,{local,Func,Obj},[{var,"Val"}]}]; _ -> - [{apply,{Mod,Func},[{var,"Val"}]}] + [{apply,{Mod,Func,Obj},[{var,"Val"}]}] end end. @@ -1540,12 +1538,12 @@ gen_enc_choices([H|T], Erule, TopType, Pos, Constr, Ext) -> no -> case Type#type.tablecinf of [{objfun,_}|_] -> - {"got objfun through args","ObjFun"}; + {"got objfun through args",{var,"ObjFun"}}; _ -> false end; _ -> - {no_attr,"ObjFun"} + {no_attr,{var,"ObjFun"}} end, DoExt = case Constr of ext -> Ext; @@ -1561,7 +1559,7 @@ gen_enc_choices([H|T], Erule, TopType, Pos, Constr, 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', + Body = gen_enc_line_imm(Erule, TopType, Cname, Type, {var,"ChoiceVal"}, EncObj, DoExt), Imm = Tag ++ Body, [{Cname,Imm}|gen_enc_choices(T, Erule, TopType, Pos+1, Constr, Ext)]; @@ -1778,3 +1776,13 @@ 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). + +enc_dig_out_value([], Value) -> + {[],Value}; +enc_dig_out_value([{N,_}|T], Value) -> + {Imm0,Dst0} = enc_dig_out_value(T, Value), + {Imm,Dst} = asn1ct_imm:enc_element(N, Dst0), + {Imm0++Imm,Dst}. + +make_var(Base) -> + {var,atom_to_list(asn1ct_gen:mk_var(asn1ct_name:curr(Base)))}. diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl index dbadedb683..33f998722a 100644 --- a/lib/asn1/src/asn1ct_func.erl +++ b/lib/asn1/src/asn1ct_func.erl @@ -48,7 +48,7 @@ need(MFA) -> call_gen(Prefix, Key, Gen, Args) when is_function(Gen, 2) -> F = req({gen_func,Prefix,Key,Gen}), - asn1ct_gen:emit([F,"(",call_args(Args, ""),")"]). + asn1ct_gen:emit([{asis,F},"(",call_args(Args, ""),")"]). call_gen(Prefix, Key, Gen) when is_function(Gen, 2) -> req({gen_func,Prefix,Key,Gen}). diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 30d337635b..37b33194d0 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -23,6 +23,7 @@ -export([demit/1, emit/1, + open_output_file/1,close_output_file/0, get_inner/1,type/1,def_to_tag/1,prim_bif/1, list2name/1, list2rname/1, @@ -70,8 +71,7 @@ pgen_module(OutFile,Erules,Module, HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), - Fid = fopen(ErlFile), - put(gen_file_out,Fid), + open_output_file(ErlFile), asn1ct_func:start_link(), gen_head(Erules,Module,HrlGenerated), pgen_exports(Erules,Module,TypeOrVal), @@ -85,9 +85,9 @@ pgen_module(OutFile,Erules,Module, "%%%",nl, "%%% Run-time functions.",nl, "%%%",nl]), - asn1ct_func:generate(Fid), - file:close(Fid), - _ = erase(gen_file_out), + Fd = get(gen_file_out), + asn1ct_func:generate(Fd), + close_output_file(), _ = erase(outfile), asn1ct:verbose("--~p--~n",[{generated,ErlFile}],Options). @@ -1121,8 +1121,7 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), - Fid = fopen(File), - put(gen_file_out,Fid), + open_output_file(File), gen_hrlhead(Module). %% EMIT functions ************************ @@ -1195,15 +1194,19 @@ call_args([A|As], Sep) -> [Sep,do_emit(A)|call_args(As, ", ")]; call_args([], _) -> []. -fopen(F) -> +open_output_file(F) -> case file:open(F, [write,raw,delayed_write]) of - {ok, Fd} -> + {ok,Fd} -> + put(gen_file_out, Fd), Fd; {error, Reason} -> io:format("** Can't open file ~p ~n", [F]), exit({error,Reason}) end. +close_output_file() -> + ok = file:close(erase(gen_file_out)). + pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> put(currmod,Module), {Types,Values,Ptypes,_,_,_} = TypeOrVal, @@ -1226,8 +1229,7 @@ pgen_hrl(Erules,Module,TypeOrVal,Options,_Indent) -> 0 -> 0; Y -> - Fid = get(gen_file_out), - file:close(Fid), + close_output_file(), asn1ct:verbose("--~p--~n", [{generated,lists:concat([get(outfile),".hrl"])}], Options), diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 8b999ddbf0..7ba649c874 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -99,7 +99,7 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> gen_encode_prim(Erules, D) -> - Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + Value = {var,atom_to_list(asn1ct_gen:mk_var(asn1ct_name:curr(val)))}, gen_encode_prim(Erules, D, Value). gen_encode_prim(Erules, #type{}=D, Value) -> @@ -149,10 +149,10 @@ gen_encode_prim_imm(Val, #type{def=Type0,constraint=Constraint}, Aligned) -> case Constraint of [#'Externaltypereference'{type=Tname}] -> EncFunc = enc_func(Tname), - Imm = [{apply,EncFunc,[{expr,Val}]}], + Imm = [{apply,{local,EncFunc,[]},[Val]}], asn1ct_imm:per_enc_open_type(Imm, Aligned); [] -> - Imm = [{call,erlang,iolist_to_binary,[{expr,Val}]}], + Imm = [{call,erlang,iolist_to_binary,[Val]}], asn1ct_imm:per_enc_open_type(Imm, Aligned) end end. diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 047156fc10..c14f0b889f 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -36,7 +36,7 @@ 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_absent/3,enc_append/1,enc_element/2]). -export([enc_cg/2]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). @@ -256,33 +256,25 @@ per_enc_k_m_string(Val0, StringType, Constraint, Aligned) -> 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. + Imm = case Aligned of + true -> + %% Temporarily make the implicit 'align' done by + %% complete/1 explicit to facilitate later + %% optimizations: the absence of 'align' can be used + %% as an indication that complete/1 can be replaced + %% with a cheaper operation such as + %% iolist_to_binary/1. The redundant 'align' will be + %% optimized away later. + Imm0 ++ [{put_bits,0,0,[1,align]}]; + false -> + Imm0 + end, + {[],[[],Val,Len,Bin]} = mk_vars([], [output,len,bin]), + [{list,Imm,Val}, + {call,enc_mod(Aligned),complete,[Val],Bin}, + {call,erlang,byte_size,[Bin],Len}| + per_enc_length(Bin, 8, Len, Aligned)]. per_enc_octet_string(Val0, Constraint0, Aligned) -> {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), @@ -316,28 +308,27 @@ per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> _ -> [{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"}}]. + {list,[{'cond',[[{eq,Bitmap,0}], + ['_'|Length ++ PutBits]]}], + {var,"Extensions"}}]. per_enc_optional(Val0, {Pos,DefVals}, _Aligned) when is_integer(Pos), is_list(DefVals) -> - Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), - {B,[Val]} = mk_vars(Val1, []), + {B,Val} = enc_element(Pos, Val0), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, B++[{'cond', [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; per_enc_optional(Val0, {Pos,{call,M,F,A}}, _Aligned) when is_integer(Pos) -> - Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), - {B,[Val,Tmp]} = mk_vars(Val1, [tmp]), + {B,Val} = enc_element(Pos, Val0), + {[],[[],Tmp]} = mk_vars([], [tmp]), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, B++[{call,M,F,[Val|A],Tmp}, {'cond', [[{eq,Tmp,true},Zero],['_',One]]}]; per_enc_optional(Val0, Pos, _Aligned) when is_integer(Pos) -> - Val1 = lists:concat(["element(",Pos,", ",Val0,")"]), - {B,[Val]} = mk_vars(Val1, []), + {B,Val} = enc_element(Pos, Val0), Zero = {put_bits,0,1,[1]}, One = {put_bits,1,1,[1]}, B++[{'cond',[[{eq,Val,asn1_NOVALUE},Zero], @@ -391,20 +382,22 @@ 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_element(N, Val0) -> + {[],[Val,Dst]} = mk_vars(Val0, [element]), + {[{call,erlang,element,[N,Val],Dst}],Dst}. enc_cg(Imm0, false) -> Imm1 = enc_cse(Imm0), - Imm = enc_pre_cg(Imm1), + Imm2 = enc_pre_cg(Imm1), + Imm = enc_opt(Imm2), 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), + Imm5 = enc_pre_cg(Imm4), + Imm = enc_opt(Imm5), enc_cg(Imm). %%% @@ -972,11 +965,11 @@ mk_dest(S) -> S. 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({set,_,_}) -> true; +is_nonbuilding({list,_,_}) -> true; is_nonbuilding({sub,_,_,_}) -> true; is_nonbuilding({'try',_,_,_,_}) -> true; is_nonbuilding(_) -> false. @@ -986,17 +979,13 @@ mk_vars(Input0, Temps) -> 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) -> + case Input0 of + {var,Name} when is_list(Name) -> {[],[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)]} + _ when is_integer(Input0) -> + {[],[Input0|mk_vars_1(Base, Temps)]} end. mk_vars_1(Base, Vars) -> @@ -1143,8 +1132,15 @@ per_enc_length(Bin, Unit, Len, {Lb,Ub}, Aligned, Type) 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, +per_enc_length(Bin, Unit0, Len, Sv, Aligned, Type) when is_integer(Sv) -> + NumBits = Sv*Unit0, + Unit = case NumBits rem 8 of + 0 -> + %% Help out the alignment optimizer. + 8; + _ -> + Unit0 + end, U = unit(Unit, Aligned, Type, NumBits, NumBits), Pb = {put_bits,Bin,binary,U}, [{'cond',[[{eq,Len,Sv},Pb]]}]. @@ -1358,58 +1354,6 @@ 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). %%% @@ -1587,16 +1531,16 @@ collect_put_bits(Imm) -> %%% the same element twice. %%% -enc_cse([{assign,{var,V},E}=H|T]) -> - [H|enc_cse_1(T, E, V)]; +enc_cse([{call,erlang,element,Args,V}=H|T]) -> + [H|enc_cse_1(T, Args, 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([{call,erlang,element,Args,Dst}|T], Args, V) -> + [{set,V,Dst}|enc_cse_1(T, Args, V)]; +enc_cse_1([{block,Bl}|T], Args, V) -> + [{block,enc_cse_1(Bl, Args, V)}|enc_cse_1(T, Args, V)]; +enc_cse_1([H|T], Args, V) -> + [H|enc_cse_1(T, Args, V)]; enc_cse_1([], _, _) -> []. @@ -1637,7 +1581,7 @@ 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, _, _) -> +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], @@ -1662,18 +1606,22 @@ 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({binary,H0++H1}, T); +enc_make_cons({binary,H}, {cons,{integer,Int},T}) -> + enc_make_cons({binary,H++[{put_bits,Int,8,[1]}]}, T); enc_make_cons({integer,Int}, {binary,T}) -> {binary,[{put_bits,Int,8,[1]}|T]}; +enc_make_cons({integer,Int}, {cons,{binary,H},T}) -> + enc_make_cons({binary,[{put_bits,Int,8,[1]}|H]}, 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({list,List0,Dst}, _StL) -> + List = enc_pre_cg_1(List0, outside_list, outside_seq), + {list,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), @@ -1681,6 +1629,562 @@ enc_pre_cg_nonbuilding({'try',Try0,{P,Succ0},Else0,Dst}, StL) -> {'try',Try,{P,Succ},Else,Dst}; enc_pre_cg_nonbuilding(Imm, _) -> Imm. +%%% +%%% Optimize calls to complete/1 and surrounding code. There are +%%% several opportunities for optimizations. +%%% +%%% It may be possible to replace the call to complete/1 with +%%% something cheaper (most important for the PER back-end which has +%%% an expensive complete/1 implementation). If we can be sure that +%%% complete/1 will be called with an iolist (no 'align' atoms or +%%% bitstrings in the list), we can call iolist_to_binary/1 +%%% instead. If the list may include bitstrings, we can can call +%%% list_to_bitstring/1 (note that list_to_bitstring/1 does not accept +%%% a binary or bitstring, so we MUST be sure that we only pass it a +%%% list). If complete/1 is called with a binary, we can omit the +%%% call altogether. +%%% +%%% A call to byte_size/1 that follows complete/1 can be eliminated +%%% if the size of the binary produced by complete/1 can be determined +%%% and is constant. +%%% +%%% The code that encodes the length descriptor (a 'cond' instruction) +%%% for a binary produced by complete/1 can be simplified if the lower +%%% and upper bounds for the size of the binary are known. +%%% + +-record(ost, + {sym, + t + }). + +enc_opt(Imm0) -> + {Imm,_} = enc_opt(Imm0, #ost{sym=gb_trees:empty()}), + Imm. + +enc_opt(align, St) -> + {align,St#ost{t=t_align({0,7})}}; +enc_opt({apply,What,As}, St) -> + {{apply,What,subst_list(As, St)},St#ost{t=t_any()}}; +enc_opt({assign,_,_}=Imm, St) -> + {Imm,St}; +enc_opt({binary,PutBits0}, St) -> + PutBits = [{put_bits,subst(V, St),Sz,F} || + {put_bits,V,Sz,F} <- PutBits0], + NumBits = lists:foldl(fun({put_bits,_,Bits,_}, Sum) -> + Sum+Bits + end, 0, PutBits), + {{binary,PutBits},St#ost{t=t_bitstring(NumBits)}}; +enc_opt({block,Bl0}, St0) -> + {Bl,St} = enc_opt(Bl0, St0), + {{block,Bl},St}; +enc_opt({call,binary,encode_unsigned,[Int],Bin}=Imm, St0) -> + Type = get_type(Int, St0), + St = case t_range(Type) of + any -> + set_type(Bin, t_binary(), St0); + {Lb0,Ub0} -> + Lb = bit_size(binary:encode_unsigned(Lb0)), + Ub = bit_size(binary:encode_unsigned(Ub0)), + set_type(Bin, t_binary({Lb,Ub}), St0) + end, + {Imm,St}; +enc_opt({call,erlang,bit_size,[Bin],Dst}=Imm0, St0) -> + Type = get_type(Bin, St0), + case t_range(Type) of + any -> + St1 = set_type(Bin, t_bitstring(), St0), + St = propagate(Dst, + fun(T, S) -> + bit_size_propagate(Bin, T, S) + end, St1), + {Imm0,St}; + {Lb,Ub}=Range -> + St = set_type(Dst, t_integer(Range), St0), + Imm = case Lb of + Ub -> none; + _ -> Imm0 + end, + {Imm,St} + end; +enc_opt({call,erlang,byte_size,[Bin],Dst}=Imm0, St0) -> + Type = get_type(Bin, St0), + case t_range(Type) of + any -> + St1 = set_type(Bin, t_binary(), St0), + St = propagate(Dst, + fun(T, S) -> + byte_size_propagate(Bin, T, S) + end, St1), + {Imm0,St}; + {Lb0,Ub0} -> + Lb = (Lb0+7) div 8, + Ub = (Ub0+7) div 8, + St = set_type(Dst, t_integer({Lb,Ub}), St0), + Imm = case Lb of + Ub -> none; + _ -> Imm0 + end, + {Imm,St} + end; +enc_opt({call,erlang,iolist_to_binary,_}=Imm, St) -> + {Imm,St#ost{t=t_binary()}}; +enc_opt({call,erlang,length,[List],Dst}=Imm0, St0) -> + St1 = propagate(Dst, + fun(T, S) -> + length_propagate(List, T, S) + end, St0), + {Imm0,St1}; +enc_opt({call,per,complete,[Data],Dst}, St0) -> + Type = get_type(Data, St0), + St = set_type(Dst, t_binary(t_range(Type)), St0), + case t_type(Type) of + binary -> + {{set,Data,Dst},St}; + bitlist -> + %% We KNOW that list_to_bitstring/1 will construct + %% a binary (the number of bits is divisible by 8) + %% because per_enc_open_type/2 added an 'align' atom + %% at the end. If that 'align' atom had not been + %% optimized away, the type would have been 'align' + %% instead of 'bitlist'. + {{call,erlang,list_to_bitstring,[Data],Dst},St}; + iolist -> + {{call,erlang,iolist_to_binary,[Data],Dst},St}; + nil -> + Imm = {list,{binary,[{put_bits,0,8,[1]}]},Dst}, + enc_opt(Imm, St0); + _ -> + {{call,per,complete,[Data],Dst},St} + end; +enc_opt({call,uper,complete,[Data],Dst}, St0) -> + Type = get_type(Data, St0), + St = set_type(Dst, t_binary(t_range(Type)), St0), + case t_type(Type) of + binary -> + {{set,Data,Dst},St0}; + iolist -> + {{call,erlang,iolist_to_binary,[Data],Dst},St}; + nil -> + Imm = {list,{binary,[{put_bits,0,8,[1]}]},Dst}, + enc_opt(Imm, St0); + _ -> + %% 'bitlist' or 'any'. + {{call,uper,complete,[Data],Dst},St} + end; +enc_opt({call,per_common,encode_chars,[List,NumBits|_],Dst}=Imm, St0) -> + %% Note: Never used when NumBits =:= 8 (list_to_binary/1 will + %% be used instead). + St1 = set_type(Dst, t_bitstring(), St0), + St = propagate(List, + fun(T, S) -> + char_propagate(Dst, T, NumBits, S) + end, St1), + {Imm,St}; +enc_opt({call,per_common,encode_chars_16bit,[List],Dst}=Imm, St0) -> + St1 = set_type(Dst, t_binary(), St0), + St = propagate(List, + fun(T, S) -> + char_propagate(Dst, T, 16, S) + end, St1), + {Imm,St}; +enc_opt({call,per_common,encode_big_chars,[List],Dst}=Imm, St0) -> + St1 = set_type(Dst, t_binary(), St0), + St = propagate(List, + fun(T, S) -> + char_propagate(Dst, T, 32, S) + end, St1), + {Imm,St}; +enc_opt({call,per_common,encode_fragmented,[_,Unit]}=Imm, St) -> + T = case Unit rem 8 of + 0 -> t_iolist(); + _ -> t_bitlist() + end, + {Imm,St#ost{t=T}}; +enc_opt({call,per_common,encode_unconstrained_number,_}=Imm, St) -> + {Imm,St#ost{t=t_iolist()}}; +enc_opt({call,per_common,bitstring_from_positions,_}=Imm, St) -> + {Imm,St#ost{t=t_bitstring()}}; +enc_opt({call,per_common,to_named_bitstring,_}=Imm, St) -> + {Imm,St#ost{t=t_bitstring()}}; +enc_opt({call,_,_,_}=Imm, St) -> + {Imm,St#ost{t=t_any()}}; +enc_opt({call,_,_,_,_}=Imm, St) -> + {Imm,St#ost{t=undefined}}; +enc_opt({call_gen,N,K,F,L,As}, St) -> + {{call_gen,N,K,F,L,subst(As, St)},St#ost{t=t_any()}}; +enc_opt({'cond',Cs0}, St0) -> + case enc_opt_cs(Cs0, St0) of + [{'_',Imm,Type}] -> + {Imm,St0#ost{t=Type}}; + [{Cond,Imm,Type0}|Cs1] -> + {Cs,Type} = enc_opt_cond_1(Cs1, Type0, [{Cond,Imm}]), + {{'cond',Cs},St0#ost{t=Type}} + end; +enc_opt({cons,H0,T0}, St0) -> + {H,#ost{t=TypeH}=St1} = enc_opt(H0, St0), + {T,#ost{t=TypeT}=St} = enc_opt(T0, St1), + {{cons,H,T},St#ost{t=t_cons(TypeH, TypeT)}}; +enc_opt({error,_}=Imm, St) -> + {Imm,St#ost{t=t_any()}}; +enc_opt({integer,V}, St) -> + {{integer,subst(V, St)},St#ost{t=t_integer()}}; +enc_opt({lc,E0,B,C}, St) -> + {E,_} = enc_opt(E0, St), + {{lc,E,B,C},St#ost{t=t_any()}}; +enc_opt({lc,E0,B,C,Dst}, St) -> + {E,_} = enc_opt(E0, St), + {{lc,E,B,C,Dst},St#ost{t=undefined}}; +enc_opt({list,Imm0,Dst}, St0) -> + {Imm,#ost{t=Type}=St1} = enc_opt(Imm0, St0), + St = set_type(Dst, Type, St1), + {{list,Imm,Dst},St#ost{t=undefined}}; +enc_opt(nil, St) -> + {nil,St#ost{t=t_nil()}}; +enc_opt({seq,H0,T0}, St0) -> + {H,St1} = enc_opt(H0, St0), + {T,St} = enc_opt(T0, St1), + case {H,T} of + {none,_} -> + {T,St}; + {{list,Imm,Data}, + {seq,{call,per,complete,[Data],_},_}} -> + %% Get rid of any explicit 'align' added by per_enc_open_type/2. + {{seq,{list,remove_trailing_align(Imm),Data},T},St}; + {_,_} -> + {{seq,H,T},St} + end; +enc_opt({set,_,_}=Imm, St) -> + {Imm,St#ost{t=undefined}}; +enc_opt({sub,Src0,Int,Dst}, St0) -> + Src = subst(Src0, St0), + Type = get_type(Src, St0), + St = case t_range(Type) of + any -> + propagate(Dst, + fun(T, S) -> + set_type(Src, t_add(T, Int), S) + end, + St0); + {Lb,Ub} -> + set_type(Dst, t_integer({Lb-Int,Ub-Int}), St0) + end, + {{sub,Src,Int,Dst},St#ost{t=undefined}}; +enc_opt({'try',Try0,{P,Succ0},Else0,Dst}, St0) -> + {Try,_} = enc_opt(Try0, St0), + {Succ,_} = enc_opt(Succ0, St0), + {Else,_} = enc_opt(Else0, St0), + {{'try',Try,{P,Succ},Else,Dst},St0#ost{t=undefined}}; +enc_opt({var,_}=Imm, St) -> + Type = get_type(Imm, St), + {subst(Imm, St),St#ost{t=Type}}. + +remove_trailing_align({block,Bl}) -> + {block,remove_trailing_align(Bl)}; +remove_trailing_align({cons,H,{cons,align,nil}}) -> + H; +remove_trailing_align({seq,H,T}) -> + {seq,H,remove_trailing_align(T)}; +remove_trailing_align(Imm) -> Imm. + +bit_size_propagate(Bin, Type, St) -> + case t_range(Type) of + any -> + St; + {Lb,Ub} -> + set_type(Bin, t_bitstring({Lb,Ub}), St) + end. + +byte_size_propagate(Bin, Type, St) -> + case t_range(Type) of + any -> + St; + {Lb,Ub} -> + set_type(Bin, t_binary({Lb*8,Ub*8}), St) + end. + +char_propagate(Dst, T, NumBits, St) -> + case t_range(T) of + any -> + St; + {Sz,Sz} when Sz*NumBits rem 8 =:= 0 -> + Bits = Sz*NumBits, + set_type(Dst, t_binary({Bits,Bits}), St); + {Lb,Ub} -> + Range = {Lb*NumBits,Ub*NumBits}, + case NumBits rem 8 of + 0 -> + set_type(Dst, t_binary(Range), St); + _ -> + set_type(Dst, t_bitstring(Range), St) + end + end. + +length_propagate(List, Type, St) -> + set_type(List, t_list(t_range(Type)), St). + +enc_opt_cond_1([{Cond,{error,_}=Imm,_}|T], St, Acc) -> + enc_opt_cond_1(T, St, [{Cond,Imm}|Acc]); +enc_opt_cond_1([{Cond,Imm,Curr0}|T], Curr1, Acc) -> + Curr = t_join(Curr0, Curr1), + enc_opt_cond_1(T, Curr, [{Cond,Imm}|Acc]); +enc_opt_cond_1([], St, Acc) -> + {lists:reverse(Acc),St}. + +enc_opt_cs([{Cond,Imm0}|T], St0) -> + case eo_eval_cond(Cond, St0) of + false -> + enc_opt_cs(T, St0); + true -> + {Imm,#ost{t=Type}} = enc_opt(Imm0, St0), + [{'_',Imm,Type}]; + maybe -> + St = update_type_info(Cond, St0), + {Imm,#ost{t=Type}} = enc_opt(Imm0, St), + [{Cond,Imm,Type}|enc_opt_cs(T, St0)] + end; +enc_opt_cs([], _) -> []. + +eo_eval_cond('_', _) -> + true; +eo_eval_cond({Op,{var,_}=Var,Val}, St) -> + Type = get_type(Var, St), + case t_range(Type) of + any -> maybe; + {_,_}=Range -> eval_cond_range(Op, Range, Val) + end; +eo_eval_cond({_Op,{expr,_},_Val}, _St) -> maybe. + +eval_cond_range(lt, {Lb,Ub}, Val) -> + if + Ub < Val -> true; + Val =< Lb -> false; + true -> maybe + end; +eval_cond_range(_Op, _Range, _Val) -> maybe. + +update_type_info({ult,{var,_}=Var,Val}, St) -> + Int = t_integer({0,Val-1}), + Type = t_meet(get_type(Var, St), Int), + set_type(Var, Type, St); +update_type_info({lt,{var,_}=Var,Val}, St) -> + Int = t_integer({0,Val-1}), + Type = t_meet(get_type(Var, St), Int), + set_type(Var, Type, St); +update_type_info({eq,{var,_}=Var,Val}, St) when is_integer(Val) -> + Int = t_integer(Val), + Type = t_meet(get_type(Var, St), Int), + set_type(Var, Type, St); +update_type_info({eq,_,_}, St) -> + St; +update_type_info({ge,_,_}, St) -> St. + +subst_list(As, St) -> + [subst(A, St) || A <- As]. + +subst({var,_}=Var, St) -> + Type = get_type(Var, St), + case t_type(Type) of + integer -> + case t_range(Type) of + any -> Var; + {Val,Val} -> Val; + {_,_} -> Var + end; + _ -> + Var + end; +subst(V, _St) -> V. + +set_type({var,Var}, {_,_}=Type, #ost{sym=Sym0}=St0) -> + Sym1 = gb_trees:enter(Var, Type, Sym0), + case gb_trees:lookup({propagate,Var}, Sym1) of + none -> + St0#ost{sym=Sym1}; + {value,Propagate} -> + Sym = gb_trees:delete({propagate,Var}, Sym1), + St = St0#ost{sym=Sym}, + Propagate(Type, St) + end. + +get_type({var,V}, #ost{sym=Sym}) -> + case gb_trees:lookup(V, Sym) of + none -> t_any(); + {value,T} -> T + end. + +propagate({var,Var}, Propagate, #ost{sym=Sym0}=St) when is_function(Propagate, 2) -> + Sym = gb_trees:enter({propagate,Var}, Propagate, Sym0), + St#ost{sym=Sym}. + +%%% +%%% A simple type system. +%%% +%%% Each type descriptions is a tuple {Type,Range}. +%%% Type is one of the following atoms: +%%% +%%% Type name Description +%%% --------- ----------- +%%% any Anything. +%%% +%%% align Basically iodata, but the list may contain bitstrings +%%% and the the atom 'align'. Can be passed to complete/1 +%%% to construct a binary. Only used for aligned PER (per). +%%% +%%% bitstring An Erlang bitstring. +%%% +%%% bitlist A list that may be passed to list_to_bitstring/1 to +%%% construct a bitstring. +%%% NOTE: When analysing aligned PER (per), the number +%%% of bits in the bitlist is always divisible by 8 (if +%%% not, the type will be 'align' instead). +%%% +%%% binary An Erlang binary (the number of bits is divisible by 8). +%%% +%%% iolist An Erlang iolist. +%%% +%%% nil [] +%%% +%%% integer An integer. +%%% +%%% +%%% Range is one of: +%%% +%%% any +%%% {LowerBound,UpperBound} +%%% +%%% + +t_align(Range) -> + {align,t__range(Range)}. + +t_any() -> + {any,any}. + +t_binary() -> + {binary,any}. + +t_binary(Range) -> + {binary,t__range(Range)}. + +t_bitlist() -> + {bitlist,any}. + +t_bitstring() -> + {bitstring,any}. + +t_bitstring(Range0) -> + case t__range(Range0) of + {Bits,Bits}=Range when Bits rem 8 =:= 0 -> + {binary,Range}; + Range -> + {bitstring,Range} + end. + +t_add({integer,{Lb,Ub}}, N) -> + {integer,{Lb+N,Ub+N}}. + +t_cons({_,_}=T1, {_,_}=T2) -> + T = case {t__cons_type(T1),t__cons_type(T2)} of + {_,any} -> any; + {any,_} -> any; + {align,_} -> align; + {_,align} -> align; + {binary,binary} -> iolist; + {binary,bitstring} -> bitlist; + {bitstring,binary} -> bitlist; + {bitstring,bitstring} -> bitlist + end, + {T,t__cons_ranges(t__cons_range(T1), t__cons_range(T2))}. + +t_integer() -> + {integer,any}. + +t_integer(Range) -> + {integer,t__range(Range)}. + +t_iolist() -> + {iolist,any}. + +t_list(Range) -> + {list,t__range(Range)}. + +t_nil() -> + {nil,{0,0}}. + +t_meet({T1,Range1}, {T2,Range2}) -> + {t_meet_types(T1, T2),t_meet_ranges(Range1, Range2)}. + +t_meet_types(integer, integer) -> integer; +t_meet_types(any, integer) -> integer. + +t_meet_ranges(any, Range) -> + Range; +t_meet_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> + if + Lb1 =< Ub2, Lb2 =< Ub1 -> + {max(Lb1, Lb2),Ub1}; + Lb2 =< Ub1, Lb1 =< Ub2 -> + {max(Lb1, Lb2),Ub2} + end. + +t_join({T1,Range1}, {T2,Range2}) -> + T = t_join_types(lists:sort([T1,T2])), + Range = t_join_ranges(Range1, Range2), + {T,Range}. + +t_join_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> + {min(Lb1, Lb2),max(Ub1, Ub2)}; +t_join_ranges(any, _) -> any; +t_join_ranges(_, any) -> any. + +t_join_types([T,T]) -> T; +t_join_types([align,any]) -> any; +t_join_types([align,_]) -> align; +t_join_types([any,_]) -> any; +t_join_types([bitlist,bitstring]) -> any; +t_join_types([bitlist,integer]) -> any; +t_join_types([bitlist,iolist]) -> bitlist; +t_join_types([bitlist,nil]) -> bitlist; +t_join_types([binary,bitlist]) -> bitlist; +t_join_types([binary,bitstring]) -> bitstring; +t_join_types([binary,integer]) -> binary; +t_join_types([binary,iolist]) -> iolist; +t_join_types([binary,nil]) -> iolist; +t_join_types([bitstring,integer]) -> any; +t_join_types([bitstring,iolist]) -> any; +t_join_types([bitstring,nil]) -> any; +t_join_types([integer,_]) -> any; +t_join_types([iolist,nil]) -> iolist. + +t_type({T,_}) -> T. + +t_range({_,Range}) -> Range. + +t__cons_type({align,_}) -> align; +t__cons_type({any,_}) -> any; +t__cons_type({binary,_}) -> binary; +t__cons_type({bitstring,_}) -> bitstring; +t__cons_type({bitlist,_}) -> bitstring; +t__cons_type({integer,_}) -> binary; +t__cons_type({iolist,_}) -> binary; +t__cons_type({nil,_}) -> binary. + +t__cons_range({integer,_}) -> {8,8}; +t__cons_range({_,Range}) -> Range. + +t__cons_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> + {Lb1+Lb2,Ub1+Ub2}; +t__cons_ranges(any, _) -> any; +t__cons_ranges(_, any) -> any. + +t__range({Lb,Ub}=Range) when is_integer(Lb), is_integer(Ub) -> + Range; +t__range(any) -> + any; +t__range(Val) when is_integer(Val) -> + {Val,Val}. + %%% %%% Code generation for encoding. @@ -1702,19 +2206,10 @@ enc_cg(align) -> enc_cg({apply,F0,As0}) -> As = enc_call_args(As0, ""), case F0 of - {M,F} -> - emit([{asis,M},":",{asis,F},"(",As,")"]); - F when is_atom(F) -> - emit([{asis,F},"(",As,")"]) - end; -enc_cg({apply,F0,As0,Dst}) -> - As = enc_call_args(As0, ""), - emit([mk_val(Dst)," = "]), - case F0 of - {M,F} -> - emit([{asis,M},":",{asis,F},"(",As,")"]); - F when is_atom(F) -> - emit([{asis,F},"(",As,")"]) + {local,F,_} when is_atom(F) -> + emit([{asis,F},"(",As,")"]); + {M,F,_} -> + emit([{asis,M},":",{asis,F},"(",As,")"]) end; enc_cg({assign,Dst0,Expr}) -> Dst = mk_val(Dst0), @@ -1728,15 +2223,11 @@ 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}) -> +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}) -> @@ -1752,12 +2243,17 @@ enc_cg({lc,Body,Var,List,Dst}) -> emit([mk_val(Dst)," = ["]), enc_cg(Body), emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]); +enc_cg({list,List,Dst}) -> + emit([mk_val(Dst)," = "]), + enc_cg(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({set,{var,Src},{var,Dst}}) -> + emit([Dst," = ",Src]); enc_cg({'try',Try,{P,Succ},Else,Dst}) -> emit([mk_val(Dst)," = try "]), enc_cg(Try), @@ -1792,8 +2288,6 @@ 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, ""), @@ -1849,7 +2343,7 @@ mk_val(Other) -> {asis,Other}. bit_string_name2pos_fun(NNL, Src) -> {call_gen,"bit_string_name2pos_",NNL, - fun(Fd, Name) -> gen_name2pos(Fd, Name, NNL) end,[Src]}. + fun(Fd, Name) -> gen_name2pos(Fd, Name, NNL) end,[],[Src]}. gen_name2pos(Fd, Name, Names) -> Cs0 = gen_name2pos_cs(Names, Name), @@ -1978,19 +2472,12 @@ 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) -> @@ -2012,6 +2499,10 @@ enc_opt_al({'cond',Cs0}, Al0) -> {[{'cond',Cs}],Al}; enc_opt_al({error,_}=Imm, Al) -> {[Imm],Al}; +enc_opt_al({list,Imm0,Dst}, Al) -> + Imm1 = enc_opt_hoist_align(Imm0), + {Imm,_} = enc_opt_al_1(Imm1, 0), + {[{list,Imm,Dst}],Al}; enc_opt_al({put_bits,V,N,[U,align]}, Al0) when Al0 rem 8 =:= 0 -> Al = if is_integer(N) -> N*U; @@ -2038,8 +2529,12 @@ 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({set,_,_}=Imm, Al) -> + {[Imm],Al}; enc_opt_al({sub,_,_,_}=Imm, Al) -> {[Imm],Al}; +enc_opt_al({'try',_,_,_,_}=Imm, Al) -> + {[Imm],Al}; enc_opt_al(Imm, _) -> {[Imm],unknown}. @@ -2063,29 +2558,25 @@ enc_opt_al_cond_1([], _, CAcc, AAcc) -> 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}} +enc_opt_hoist_align([{'cond',Cs0},{put_bits,0,0,[1,align]}]=Imm) -> + try + Cs = [insert_align_last(C) || C <- Cs0], + [{'cond',Cs}] 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]}]. + Imm + end; +enc_opt_hoist_align(Imm) -> Imm. +insert_align_last([_,{error,_}]=C) -> + C; +insert_align_last([H|T]) -> + case lists:last(T) of + {put_bits,_,_,_} -> + [H|T ++ [{put_bits,0,0,[1,align]}]]; + _ -> + throw(impossible) + end. %%% %%% For the aligned PER format, fix up the intermediate format @@ -2095,8 +2586,6 @@ enc_opt_al_prepare_cond_2([]) -> 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]) -> @@ -2104,14 +2593,11 @@ per_fixup([{'assign',_,_}=H|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]) -> +per_fixup([{call_gen,_,_,_,_,_}=H|T]) -> [H|per_fixup(T)]; per_fixup([{error,_}=H|T]) -> [H|per_fixup(T)]; @@ -2119,6 +2605,10 @@ 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([{list,Imm,Dst}|T]) -> + [{list,per_fixup(Imm),Dst}|per_fixup(T)]; +per_fixup([{set,_,_}=H|T]) -> + [H|per_fixup(T)]; per_fixup([{sub,_,_,_}=H|T]) -> [H|per_fixup(T)]; per_fixup([{'try',Try0,{P,Succ0},Else0,Dst}|T]) -> |