aboutsummaryrefslogtreecommitdiffstats
path: root/lib/asn1/src/asn1ct_imm.erl
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2013-04-15 18:02:45 +0200
committerBjörn Gustavsson <[email protected]>2013-08-30 10:13:18 +0200
commiteb49ee71f0751cf54bc39f9971f389c92525b0a4 (patch)
tree0d101faccacba14653cc5472b47fbe510a7a38d6 /lib/asn1/src/asn1ct_imm.erl
parentc6ba0f6aa81c2b9ce9b348106bffb808b385bd18 (diff)
downloadotp-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/asn1ct_imm.erl')
-rw-r--r--lib/asn1/src/asn1ct_imm.erl1411
1 files changed, 1411 insertions, 0 deletions
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,...]