1%% 2%% %CopyrightBegin% 3%% 4%% Copyright Ericsson AB 2012-2017. All Rights Reserved. 5%% 6%% Licensed under the Apache License, Version 2.0 (the "License"); 7%% you may not use this file except in compliance with the License. 8%% You may obtain a copy of the License at 9%% 10%% http://www.apache.org/licenses/LICENSE-2.0 11%% 12%% Unless required by applicable law or agreed to in writing, software 13%% distributed under the License is distributed on an "AS IS" BASIS, 14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15%% See the License for the specific language governing permissions and 16%% limitations under the License. 17%% 18%% %CopyrightEnd% 19%% 20%% 21-module(asn1ct_imm). 22-export([per_dec_raw_bitstring/2, 23 per_dec_boolean/0,per_dec_enumerated/2,per_dec_enumerated/3, 24 per_dec_extension_map/1, 25 per_dec_integer/2,per_dec_k_m_string/3, 26 per_dec_length/3,per_dec_named_integer/3, 27 per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1, 28 per_dec_restricted_string/1]). 29-export([per_dec_constrained/3,per_dec_normally_small_number/1]). 30-export([per_enc_bit_string/4,per_enc_legacy_bit_string/4, 31 per_enc_boolean/2, 32 per_enc_choice/3,per_enc_enumerated/3, 33 per_enc_integer/3,per_enc_integer/4, 34 per_enc_null/2, 35 per_enc_k_m_string/4,per_enc_octet_string/3, 36 per_enc_legacy_octet_string/3, 37 per_enc_open_type/2, 38 per_enc_restricted_string/3, 39 per_enc_small_number/2]). 40-export([per_enc_extension_bit/2,per_enc_extensions/4, 41 per_enc_extensions_map/4, 42 per_enc_optional/2]). 43-export([per_enc_sof/5]). 44-export([enc_absent/3,enc_append/1,enc_element/2,enc_maps_get/2, 45 enc_comment/1]). 46-export([enc_cg/2]). 47-export([optimize_alignment/1,optimize_alignment/2, 48 dec_slim_cg/2,dec_code_gen/2]). 49-export([effective_constraint/2]). 50-import(asn1ct_gen, [emit/1]). 51 52-record(st, {var, 53 base}). 54 55dec_slim_cg(Imm0, BytesVar) -> 56 {Imm,_} = optimize_alignment(Imm0), 57 asn1ct_name:new(v), 58 [H|T] = atom_to_list(asn1ct_name:curr(v)) ++ "@", 59 VarBase = [H-($a-$A)|T], 60 St0 = #st{var=0,base=VarBase}, 61 {Res,Pre,_} = flatten(Imm, BytesVar, St0), 62 dcg_list_outside(Pre), 63 Res. 64 65dec_code_gen(Imm, BytesVar) -> 66 emit(["begin",nl]), 67 {Dst,DstBuf} = dec_slim_cg(Imm, BytesVar), 68 emit([",",nl, 69 "{",Dst,",",DstBuf,"}",nl, 70 "end"]), 71 ok. 72 73optimize_alignment(Imm) -> 74 opt_al(Imm, unknown). 75 76optimize_alignment(Imm, Al) -> 77 opt_al(Imm, Al). 78 79 80per_dec_boolean() -> 81 {map,{get_bits,1,[1]},[{0,false},{1,true}]}. 82 83per_dec_enumerated([{V,_}], _Aligned) -> 84 {value,V}; 85per_dec_enumerated(NamedList0, Aligned) -> 86 Ub = length(NamedList0) - 1, 87 Constraint = [{'ValueRange',{0,Ub}}], 88 Int = per_dec_integer(Constraint, Aligned), 89 NamedList = per_dec_enumerated_fix_list(NamedList0, [enum_error], 0), 90 {map,Int,opt_map(NamedList, Int)}. 91 92per_dec_enumerated(BaseNamedList, NamedListExt0, Aligned) -> 93 Base = per_dec_enumerated(BaseNamedList, Aligned), 94 NamedListExt = per_dec_enumerated_fix_list(NamedListExt0, 95 [enum_default], 0), 96 Ext = {map,per_dec_normally_small_number(Aligned),NamedListExt}, 97 bit_case(Base, Ext). 98 99per_dec_extension_map(Aligned) -> 100 Len = per_dec_normally_small_length(Aligned), 101 {get_bits,Len,[1,bitstring]}. 102 103per_dec_integer(Constraint0, Aligned) -> 104 Constraint = effective_constraint(integer, Constraint0), 105 per_dec_integer_1(Constraint, Aligned). 106 107per_dec_length(SingleValue, _, _Aligned) when is_integer(SingleValue) -> 108 {value,SingleValue}; 109per_dec_length({{Fixed,Fixed},[]}, AllowZero, Aligned) -> 110 bit_case(per_dec_length(Fixed, AllowZero, Aligned), 111 per_dec_length(no, AllowZero, Aligned)); 112per_dec_length({{_,_}=Constr,[]}, AllowZero, Aligned) -> 113 bit_case(per_dec_length(Constr, AllowZero, Aligned), 114 per_dec_length(no, AllowZero, Aligned)); 115per_dec_length({Lb,Ub}, _AllowZero, Aligned) when is_integer(Lb), 116 is_integer(Lb) -> 117 per_dec_constrained(Lb, Ub, Aligned); 118per_dec_length(no, AllowZero, Aligned) -> 119 decode_unconstrained_length(AllowZero, Aligned). 120 121per_dec_named_integer(Constraint, NamedList0, Aligned) -> 122 Int = per_dec_integer(Constraint, Aligned), 123 NamedList = [{K,V} || {V,K} <- NamedList0] ++ [integer_default], 124 {map,Int,opt_map(NamedList, Int)}. 125 126per_dec_k_m_string(StringType, Constraint, Aligned) -> 127 SzConstr = effective_constraint(bitstring, Constraint), 128 N = string_num_bits(StringType, Constraint, Aligned), 129 Imm = dec_string(SzConstr, N, Aligned, k_m_string), 130 Chars = char_tab(Constraint, StringType, N), 131 convert_string(N, Chars, Imm). 132 133per_dec_octet_string(Constraint, Aligned) -> 134 dec_string(Constraint, 8, Aligned, 'OCTET STRING'). 135 136per_dec_raw_bitstring(Constraint, Aligned) -> 137 dec_string(Constraint, 1, Aligned, 'BIT STRING'). 138 139per_dec_open_type(Aligned) -> 140 dec_string(no, 8, Aligned, open_type). 141 142per_dec_real(Aligned) -> 143 Dec = fun(V, Buf) -> 144 emit(["{",{call,real_common,decode_real,[V]}, 145 com,Buf,"}"]) 146 end, 147 {call,Dec, 148 {get_bits,decode_unconstrained_length(true, Aligned), 149 [8,binary,{align,Aligned}]}}. 150 151per_dec_restricted_string(Aligned) -> 152 DecLen = decode_unconstrained_length(true, Aligned), 153 {get_bits,DecLen,[8,binary]}. 154 155%%% 156%%% Encoding. 157%%% 158 159per_enc_bit_string(Val, [], Constraint0, Aligned) -> 160 {B,[[],Bits]} = mk_vars([], [bits]), 161 Constraint = effective_constraint(bitstring, Constraint0), 162 B ++ [{call,erlang,bit_size,[Val],Bits}| 163 per_enc_length(Val, 1, Bits, Constraint, Aligned, 'BIT STRING')]; 164per_enc_bit_string(Val0, NNL0, Constraint0, Aligned) -> 165 {B,[Val,Bs,Bits,Positions]} = mk_vars(Val0, [bs,bits,positions]), 166 NNL = lists:keysort(2, NNL0), 167 Constraint = effective_constraint(bitstring, Constraint0), 168 ExtraArgs = case constr_min_size(Constraint) of 169 no -> []; 170 Lb -> [Lb] 171 end, 172 ToBs = case ExtraArgs of 173 [] -> 174 {call,per_common,bs_drop_trailing_zeroes,[Val]}; 175 [0] -> 176 {call,per_common,bs_drop_trailing_zeroes,[Val]}; 177 [Lower] -> 178 {call,per_common,adjust_trailing_zeroes,[Val,Lower]} 179 end, 180 B ++ [{'try', 181 [bit_string_name2pos_fun(NNL, Val)], 182 {Positions, 183 [{call,per_common,bitstring_from_positions, 184 [Positions|ExtraArgs]}]}, 185 [ToBs],Bs}, 186 {call,erlang,bit_size,[Bs],Bits}| 187 per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')]. 188 189per_enc_legacy_bit_string(Val0, [], Constraint0, Aligned) -> 190 {B,[Val,Bs,Bits]} = mk_vars(Val0, [bs,bits]), 191 Constraint = effective_constraint(bitstring, Constraint0), 192 ExtraArgs = case constr_min_size(Constraint) of 193 no -> []; 194 Lb -> [Lb] 195 end, 196 B ++ [{call,per_common,to_bitstring,[Val|ExtraArgs],Bs}, 197 {call,erlang,bit_size,[Bs],Bits}| 198 per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')]; 199per_enc_legacy_bit_string(Val0, NNL0, Constraint0, Aligned) -> 200 {B,[Val,Bs,Bits,Positions]} = mk_vars(Val0, [bs,bits,positions]), 201 NNL = lists:keysort(2, NNL0), 202 Constraint = effective_constraint(bitstring, Constraint0), 203 ExtraArgs = case constr_min_size(Constraint) of 204 no -> []; 205 0 -> []; 206 Lb -> [Lb] 207 end, 208 B ++ [{'try', 209 [bit_string_name2pos_fun(NNL, Val)], 210 {Positions, 211 [{call,per_common,bitstring_from_positions, 212 [Positions|ExtraArgs]}]}, 213 [{call,per_common,to_named_bitstring,[Val|ExtraArgs]}],Bs}, 214 {call,erlang,bit_size,[Bs],Bits}| 215 per_enc_length(Bs, 1, Bits, Constraint, Aligned, 'BIT STRING')]. 216 217per_enc_boolean(Val0, _Aligned) -> 218 {B,[Val]} = mk_vars(Val0, []), 219 B++build_cond([[{eq,Val,false},{put_bits,0,1,[1]}], 220 [{eq,Val,true},{put_bits,1,1,[1]}], 221 ['_',{error,{illegal_boolean,Val}}]]). 222 223per_enc_choice(Val0, Cs0, _Aligned) -> 224 {B,[Val]} = mk_vars(Val0, []), 225 Cs = [[{eq,Val,Tag}|opt_choice(Imm)] || {Tag,Imm} <- Cs0], 226 B++build_cond(Cs). 227 228per_enc_enumerated(Val0, {Root,Ext}, Aligned) -> 229 {B,[Val]} = mk_vars(Val0, []), 230 Constr = enumerated_constraint(Root), 231 RootCs = per_enc_enumerated_root(Root, [{put_bits,0,1,[1]}], 232 Val, Constr, Aligned), 233 ExtCs = per_enc_enumerated_ext(Ext, Val, Aligned), 234 B++[{'cond',RootCs++ExtCs++enumerated_error(Val)}]; 235per_enc_enumerated(Val0, Root, Aligned) -> 236 {B,[Val]} = mk_vars(Val0, []), 237 Constr = enumerated_constraint(Root), 238 Cs = per_enc_enumerated_root(Root, [], Val, Constr, Aligned), 239 B++[{'cond',Cs++enumerated_error(Val)}]. 240 241enumerated_error(Val) -> 242 [['_',{error,{illegal_enumerated,Val}}]]. 243 244per_enc_integer(Val0, Constraint0, Aligned) -> 245 {B,[Val]} = mk_vars(Val0, []), 246 Constraint = effective_constraint(integer, Constraint0), 247 B ++ per_enc_integer_1(Val, Constraint, Aligned). 248 249per_enc_integer(Val0, NNL, Constraint0, Aligned) -> 250 {B,[Val]} = mk_vars(Val0, []), 251 Constraint = effective_constraint(integer, Constraint0), 252 Cs = [[{eq,Val,N}|per_enc_integer_1(V, Constraint, Aligned)] || 253 {N,V} <- NNL], 254 case per_enc_integer_1(Val, Constraint, Aligned) of 255 [{'cond',IntCs}] -> 256 B ++ [{'cond',Cs++IntCs}]; 257 Other -> 258 B ++ [{'cond',Cs++[['_'|Other]]}] 259 end. 260 261per_enc_null(_Val, _Aligned) -> 262 []. 263 264per_enc_k_m_string(Val0, StringType, Constraint, Aligned) -> 265 {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), 266 SzConstraint = effective_constraint(bitstring, Constraint), 267 Unit = string_num_bits(StringType, Constraint, Aligned), 268 Chars0 = char_tab(Constraint, StringType, Unit), 269 Enc = case Unit of 270 16 -> 271 {call,per_common,encode_chars_16bit,[Val],Bin}; 272 32 -> 273 {call,per_common,encode_big_chars,[Val],Bin}; 274 8 -> 275 {call,erlang,list_to_binary,[Val],Bin}; 276 _ -> 277 case enc_char_tab(Chars0) of 278 notab -> 279 {call,per_common,encode_chars,[Val,Unit],Bin}; 280 {tab,Tab} -> 281 {call,per_common,encode_chars,[Val,Unit,Tab],Bin}; 282 {compact_map,Map} -> 283 {call,per_common,encode_chars_compact_map, 284 [Val,Unit,Map],Bin} 285 end 286 end, 287 case Unit of 288 8 -> 289 B ++ [Enc,{call,erlang,byte_size,[Bin],Len}]; 290 _ -> 291 B ++ [{call,erlang,length,[Val],Len},Enc] 292 end ++ per_enc_length(Bin, Unit, Len, SzConstraint, Aligned, k_m_string). 293 294per_enc_open_type(Imm0, Aligned) -> 295 Imm = case Aligned of 296 true -> 297 %% Temporarily make the implicit 'align' done by 298 %% complete/1 explicit to facilitate later 299 %% optimizations: the absence of 'align' can be used 300 %% as an indication that complete/1 can be replaced 301 %% with a cheaper operation such as 302 %% iolist_to_binary/1. The redundant 'align' will be 303 %% optimized away later. 304 Imm0 ++ [{put_bits,0,0,[1,align]}]; 305 false -> 306 Imm0 307 end, 308 {[],[[],Val,Len,Bin]} = mk_vars([], [output,len,bin]), 309 [{list,Imm,Val}, 310 {call,enc_mod(Aligned),complete,[Val],Bin}, 311 {call,erlang,byte_size,[Bin],Len}| 312 per_enc_length(Bin, 8, Len, Aligned)]. 313 314per_enc_octet_string(Bin, Constraint0, Aligned) -> 315 {B,[[],Len]} = mk_vars([], [len]), 316 Constraint = effective_constraint(bitstring, Constraint0), 317 B ++ [{call,erlang,byte_size,[Bin],Len}| 318 per_enc_length(Bin, 8, Len, Constraint, Aligned, 'OCTET STRING')]. 319 320per_enc_legacy_octet_string(Val0, Constraint0, Aligned) -> 321 {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), 322 Constraint = effective_constraint(bitstring, Constraint0), 323 B ++ [{call,erlang,iolist_to_binary,[Val],Bin}, 324 {call,erlang,byte_size,[Bin],Len}| 325 per_enc_length(Bin, 8, Len, Constraint, Aligned, 'OCTET STRING')]. 326 327per_enc_restricted_string(Val0, {M,F}, Aligned) -> 328 {B,[Val,Bin,Len]} = mk_vars(Val0, [bin,len]), 329 B ++ [{call,M,F,[Val],Bin}, 330 {call,erlang,byte_size,[Bin],Len}| 331 per_enc_length(Bin, 8, Len, Aligned)]. 332 333per_enc_small_number(Val, Aligned) -> 334 build_cond([[{lt,Val,64},{put_bits,Val,7,[1]}], 335 ['_',{put_bits,1,1,[1]}| 336 per_enc_unsigned(Val, Aligned)]]). 337 338per_enc_extension_bit(Val0, _Aligned) -> 339 {B,[Val]} = mk_vars(Val0, []), 340 B++build_cond([[{eq,Val,[]},{put_bits,0,1,[1]}], 341 ['_',{put_bits,1,1,[1]}]]). 342 343per_enc_extensions(Val0, Pos0, NumBits, Aligned) when NumBits > 0 -> 344 Pos = Pos0 + 1, 345 {B,[Val,Bitmap]} = mk_vars(Val0, [bitmap]), 346 Length = per_enc_small_length(NumBits, Aligned), 347 PutBits = case NumBits of 348 1 -> [{put_bits,1,1,[1]}]; 349 _ -> [{put_bits,Bitmap,NumBits,[1]}] 350 end, 351 B++[{call,per_common,extension_bitmap,[Val,Pos,Pos+NumBits],Bitmap}, 352 {list,[{'cond',[[{eq,Bitmap,0}], 353 ['_'|Length ++ PutBits]]}], 354 {var,"Extensions"}}]. 355 356per_enc_extensions_map(Val0, Vars, Undefined, Aligned) -> 357 NumBits = length(Vars), 358 {B,[_Val,Bitmap]} = mk_vars(Val0, [bitmap]), 359 Length = per_enc_small_length(NumBits, Aligned), 360 PutBits = case NumBits of 361 1 -> [{put_bits,1,1,[1]}]; 362 _ -> [{put_bits,Bitmap,NumBits,[1]}] 363 end, 364 BitmapExpr = extensions_bitmap(Vars, Undefined), 365 B++[{assign,Bitmap,BitmapExpr}, 366 {list,[{'cond',[[{eq,Bitmap,0}], 367 ['_'|Length ++ PutBits]]}], 368 {var,"Extensions"}}]. 369 370per_enc_optional(Val, DefVals) when is_list(DefVals) -> 371 Zero = {put_bits,0,1,[1]}, 372 One = {put_bits,1,1,[1]}, 373 [{'cond', 374 [[{eq,Val,DefVal},Zero] || DefVal <- DefVals] ++ [['_',One]]}]; 375per_enc_optional(Val, {call,M,F,A}) -> 376 {[],[[],Tmp]} = mk_vars([], [tmp]), 377 Zero = {put_bits,0,1,[1]}, 378 One = {put_bits,1,1,[1]}, 379 [{call,M,F,[Val|A],Tmp}, 380 {'cond', 381 [[{eq,Tmp,true},Zero],['_',One]]}]. 382 383per_enc_sof(Val0, Constraint, ElementVar, ElementImm, Aligned) -> 384 {B,[Val,Len]} = mk_vars(Val0, [len]), 385 SzConstraint = effective_constraint(bitstring, Constraint), 386 LenImm = enc_length(Len, SzConstraint, Aligned), 387 Lc0 = [{lc,ElementImm,{var,atom_to_list(ElementVar)},Val}], 388 Lc = opt_lc(Lc0, LenImm), 389 PreBlock = B ++ [{call,erlang,length,[Val],Len}], 390 case LenImm of 391 [{'cond',[[C|Action]]}] -> 392 PreBlock ++ [{'cond',[[C|Action++Lc]]}]; 393 [{sub,_,_,_}=Sub,{'cond',[[C|Action]]}] -> 394 PreBlock ++ 395 [Sub,{'cond',[[C|Action++Lc]]}]; 396 EncLen -> 397 PreBlock ++ EncLen ++ Lc 398 end. 399 400enc_absent(Val0, {call,M,F,A}, Body) -> 401 {B,[Var,Tmp]} = mk_vars(Val0, [tmp]), 402 B++[{call,M,F,[Var|A],Tmp}, 403 {'cond', 404 [[{eq,Tmp,true}],['_'|Body]]}]; 405enc_absent(Val0, AbsVals, Body) when is_list(AbsVals) -> 406 {B,[Var]} = mk_vars(Val0, []), 407 Cs = [[{eq,Var,Aval}] || Aval <- AbsVals] ++ [['_'|Body]], 408 B++build_cond(Cs). 409 410enc_append([[]|T]) -> 411 enc_append(T); 412enc_append([[{put_bits,_,_,_}|_]=Pb|[Imm|T]=T0]) -> 413 case opt_choice(Pb++Imm) of 414 [{put_bits,_,_,_}|_] -> 415 [{block,Pb}|enc_append(T0)]; 416 Opt -> 417 enc_append([Opt|T]) 418 end; 419enc_append([Imm0|[Imm1|T]=T0]) -> 420 try combine_imms(Imm0, Imm1) of 421 Imm -> 422 enc_append([Imm|T]) 423 catch 424 throw:impossible -> 425 [{block,Imm0}|enc_append(T0)] 426 end; 427enc_append([H|T]) -> 428 [{block,H}|enc_append(T)]; 429enc_append([]) -> []. 430 431enc_element(N, Val0) -> 432 {[],[Val,Dst]} = mk_vars(Val0, [element]), 433 {[{call,erlang,element,[N,Val],Dst}],Dst}. 434 435enc_maps_get(N, Val0) -> 436 {[],[Val,Dst0]} = mk_vars(Val0, [element]), 437 {var,Dst} = Dst0, 438 DstExpr = {expr,lists:concat(["#{",N,":=",Dst,"}"])}, 439 {var,SrcVar} = Val, 440 {[{assign,DstExpr,SrcVar}],Dst0}. 441 442enc_comment(Comment) -> 443 {comment,Comment}. 444 445enc_cg(Imm0, false) -> 446 Imm1 = enc_cse(Imm0), 447 Imm2 = enc_pre_cg(Imm1), 448 Imm = enc_opt(Imm2), 449 enc_cg(Imm); 450enc_cg(Imm0, true) -> 451 Imm1 = enc_cse(Imm0), 452 Imm2 = enc_hoist_align(Imm1), 453 Imm3 = enc_opt_al(Imm2), 454 Imm4 = per_fixup(Imm3), 455 Imm5 = enc_pre_cg(Imm4), 456 Imm = enc_opt(Imm5), 457 enc_cg(Imm). 458 459%%% 460%%% Local functions. 461%%% 462 463%% is_aligned(StringType, LowerBound, UpperBound) -> boolean() 464%% StringType = 'OCTET STRING' | 'BIT STRING' | k_m_string 465%% LowerBound = UpperBound = number of bits 466%% Determine whether a string should be aligned in PER. 467 468is_aligned(T, Lb, Ub) when T =:= 'OCTET STRING'; T =:= 'BIT STRING' -> 469 %% OCTET STRINGs and BIT STRINGs are aligned to a byte boundary 470 %% unless the size is fixed and less than or equal to 16 bits. 471 Lb =/= Ub orelse Lb > 16; 472is_aligned(k_m_string, _Lb, Ub) -> 473 %% X.691 (07/2002) 27.5.7 says if the upper bound times the number 474 %% of bits is greater than or equal to 16, then the bit field should 475 %% be aligned. 476 Ub >= 16. 477 478%%% 479%%% Generating the intermediate format format for decoding. 480%%% 481 482dec_string(Sv, U, Aligned0, T) when is_integer(Sv) -> 483 Bits = U*Sv, 484 Aligned = Aligned0 andalso is_aligned(T, Bits, Bits), 485 {get_bits,Sv,[U,binary,{align,Aligned}]}; 486dec_string({{Sv,Sv},[]}, U, Aligned, T) -> 487 bit_case(dec_string(Sv, U, Aligned, T), 488 dec_string(no, U, Aligned, T)); 489dec_string({{_,_}=C,[]}, U, Aligned, T) -> 490 bit_case(dec_string(C, U, Aligned, T), 491 dec_string(no, U, Aligned, T)); 492dec_string({Lb,Ub}, U, Aligned0, T) -> 493 Len = per_dec_constrained(Lb, Ub, Aligned0), 494 Aligned = Aligned0 andalso is_aligned(T, Lb*U, Ub*U), 495 {get_bits,Len,[U,binary,{align,Aligned}]}; 496dec_string(_, U, Aligned, _T) -> 497 Al = [{align,Aligned}], 498 DecRest = fun(V, Buf) -> 499 asn1ct_func:call(per_common, 500 decode_fragmented, 501 [V,Buf,U]) 502 end, 503 {'case',[{test,{get_bits,1,[1|Al]},0, 504 {value,{get_bits, 505 {get_bits,7,[1]}, 506 [U,binary]}}}, 507 {test,{get_bits,1,[1|Al]},1, 508 {test,{get_bits,1,[1]},0, 509 {value,{get_bits, 510 {get_bits,14,[1]}, 511 [U,binary]}}}}, 512 {test,{get_bits,1,[1|Al]},1, 513 {test,{get_bits,1,[1]},1, 514 {value,{call,DecRest,{get_bits,6,[1]}}}}}]}. 515 516per_dec_enumerated_fix_list([{V,_}|T], Tail, N) -> 517 [{N,V}|per_dec_enumerated_fix_list(T, Tail, N+1)]; 518per_dec_enumerated_fix_list([], Tail, _) -> Tail. 519 520per_dec_integer_1([{'SingleValue',Value}], _Aligned) -> 521 {value,Value}; 522per_dec_integer_1([{'ValueRange',{'MIN',_}}], Aligned) -> 523 per_dec_unconstrained(Aligned); 524per_dec_integer_1([{'ValueRange',{Lb,'MAX'}}], Aligned) when is_integer(Lb) -> 525 per_decode_semi_constrained(Lb, Aligned); 526per_dec_integer_1([{'ValueRange',{Lb,Ub}}], Aligned) when is_integer(Lb), 527 is_integer(Ub) -> 528 per_dec_constrained(Lb, Ub, Aligned); 529per_dec_integer_1([{{_,_}=Constr0,_}], Aligned) -> 530 Constr = effective_constraint(integer, [Constr0]), 531 bit_case(per_dec_integer(Constr, Aligned), 532 per_dec_unconstrained(Aligned)); 533per_dec_integer_1([], Aligned) -> 534 per_dec_unconstrained(Aligned). 535 536per_dec_unconstrained(Aligned) -> 537 {get_bits,decode_unconstrained_length(false, Aligned),[8,signed]}. 538 539per_dec_constrained(Lb, Ub, false) -> 540 Range = Ub - Lb + 1, 541 Get = {get_bits,uper_num_bits(Range),[1]}, 542 add_lb(Lb, Get); 543per_dec_constrained(Lb, Ub, true) -> 544 Range = Ub - Lb + 1, 545 Get = if 546 Range =< 255 -> 547 {get_bits,per_num_bits(Range),[1,unsigned]}; 548 Range == 256 -> 549 {get_bits,1,[8,unsigned,{align,true}]}; 550 Range =< 65536 -> 551 {get_bits,2,[8,unsigned,{align,true}]}; 552 true -> 553 RangeOctLen = byte_size(binary:encode_unsigned(Range - 1)), 554 {get_bits,per_dec_length({1,RangeOctLen}, false, true), 555 [8,unsigned,{align,true}]} 556 end, 557 add_lb(Lb, Get). 558 559add_lb(0, Get) -> Get; 560add_lb(Lb, Get) -> {add,Get,Lb}. 561 562per_dec_normally_small_number(Aligned) -> 563 Small = {get_bits,6,[1]}, 564 Unlimited = per_decode_semi_constrained(0, Aligned), 565 bit_case(Small, Unlimited). 566 567per_dec_normally_small_length(Aligned) -> 568 Small = {add,{get_bits,6,[1]},1}, 569 Unlimited = decode_unconstrained_length(false, Aligned), 570 bit_case(Small, Unlimited). 571 572per_decode_semi_constrained(Lb, Aligned) -> 573 add_lb(Lb, {get_bits,decode_unconstrained_length(false, Aligned),[8]}). 574 575bit_case(Base, Ext) -> 576 {'case',[{test,{get_bits,1,[1]},0,Base}, 577 {test,{get_bits,1,[1]},1,Ext}]}. 578 579decode_unconstrained_length(AllowZero, Aligned) -> 580 Al = [{align,Aligned}], 581 Zero = case AllowZero of 582 false -> [non_zero]; 583 true -> [] 584 end, 585 {'case',[{test,{get_bits,1,[1|Al]},0, 586 {value,{get_bits,7,[1|Zero]}}}, 587 {test,{get_bits,1,[1|Al]},1, 588 {test,{get_bits,1,[1]},0, 589 {value,{get_bits,14,[1|Zero]}}}}]}. 590 591uper_num_bits(N) -> 592 uper_num_bits(N, 1, 0). 593 594uper_num_bits(N, T, B) when N =< T -> B; 595uper_num_bits(N, T, B) -> uper_num_bits(N, T bsl 1, B+1). 596 597per_num_bits(2) -> 1; 598per_num_bits(N) when N =< 4 -> 2; 599per_num_bits(N) when N =< 8 -> 3; 600per_num_bits(N) when N =< 16 -> 4; 601per_num_bits(N) when N =< 32 -> 5; 602per_num_bits(N) when N =< 64 -> 6; 603per_num_bits(N) when N =< 128 -> 7; 604per_num_bits(N) when N =< 255 -> 8. 605 606opt_map(Map, Imm) -> 607 case matched_range(Imm) of 608 unknown -> Map; 609 {Lb,Ub} -> opt_map_1(Map, Lb, Ub) 610 end. 611 612opt_map_1([{I,_}=Pair|T], Lb, Ub) -> 613 if 614 I =:= Lb, I =< Ub -> 615 [Pair|opt_map_1(T, Lb+1, Ub)]; 616 Lb < I, I =< Ub -> 617 [Pair|opt_map_1(T, Lb, Ub)]; 618 true -> 619 opt_map_1(T, Lb, Ub) 620 end; 621opt_map_1(Map, Lb, Ub) -> 622 if 623 Lb =< Ub -> 624 Map; 625 true -> 626 [] 627 end. 628 629matched_range({get_bits,Bits0,[U|Flags]}) when is_integer(U) -> 630 case not lists:member(signed, Flags) andalso is_integer(Bits0) of 631 true -> 632 Bits = U*Bits0, 633 {0,(1 bsl Bits) - 1}; 634 false -> 635 unknown 636 end; 637matched_range({add,Imm,Add}) -> 638 case matched_range(Imm) of 639 unknown -> unknown; 640 {Lb,Ub} -> {Lb+Add,Ub+Add} 641 end; 642matched_range(_Op) -> unknown. 643 644string_num_bits(StringType, Constraint, Aligned) -> 645 case get_constraint(Constraint, 'PermittedAlphabet') of 646 {'SingleValue',Sv} -> 647 charbits(length(Sv), Aligned); 648 no -> 649 case StringType of 650 'IA5String' -> 651 charbits(128, Aligned); 652 'VisibleString' -> 653 charbits(95, Aligned); 654 'PrintableString' -> 655 charbits(74, Aligned); 656 'NumericString' -> 657 charbits(11, Aligned); 658 'UniversalString' -> 659 32; 660 'BMPString' -> 661 16 662 end 663 end. 664 665charbits(NumChars, false) -> 666 uper_num_bits(NumChars); 667charbits(NumChars, true) -> 668 1 bsl uper_num_bits(uper_num_bits(NumChars)). 669 670convert_string(8, notab, Imm) -> 671 {convert,binary_to_list,Imm}; 672convert_string(NumBits, notab, Imm) when NumBits < 8 -> 673 Dec = fun(V, Buf) -> 674 emit(["{",{call,per_common,decode_chars, 675 [V,NumBits]},com,Buf,"}"]) 676 end, 677 {call,Dec,Imm}; 678convert_string(NumBits, notab, Imm) when NumBits =:= 16 -> 679 Dec = fun(V, Buf) -> 680 emit(["{",{call,per_common,decode_chars_16bit, 681 [V]},com,Buf,"}"]) 682 end, 683 {call,Dec,Imm}; 684convert_string(NumBits, notab, Imm) -> 685 Dec = fun(V, Buf) -> 686 emit(["{",{call,per_common,decode_big_chars, 687 [V,NumBits]},com,Buf,"}"]) 688 end, 689 {call,Dec,Imm}; 690convert_string(NumBits, Chars, Imm) -> 691 Dec = fun(V, Buf) -> 692 emit(["{",{call,per_common,decode_chars, 693 [V,NumBits,{asis,Chars}]},com,Buf,"}"]) 694 end, 695 {call,Dec,Imm}. 696 697char_tab(C, StringType, NumBits) -> 698 case get_constraint(C, 'PermittedAlphabet') of 699 {'SingleValue',Sv} -> 700 char_tab_1(Sv, NumBits); 701 no -> 702 case StringType of 703 'IA5String' -> 704 notab; 705 'VisibleString' -> 706 notab; 707 'PrintableString' -> 708 Chars = " '()+,-./0123456789:=?" 709 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 710 "abcdefghijklmnopqrstuvwxyz", 711 char_tab_1(Chars, NumBits); 712 'NumericString' -> 713 char_tab_1(" 0123456789", NumBits); 714 'UniversalString' -> 715 notab; 716 'BMPString' -> 717 notab 718 end 719 end. 720 721char_tab_1(Chars, NumBits) -> 722 Max = lists:max(Chars), 723 BitValMax = (1 bsl NumBits) - 1, 724 if 725 Max =< BitValMax -> 726 notab; 727 true -> 728 list_to_tuple(lists:sort(Chars)) 729 end. 730 731%%% 732%%% Remove unnecessary aligning to octet boundaries. 733%%% 734 735opt_al({get_bits,E0,Opts0}, A0) -> 736 {E,A1} = opt_al(E0, A0), 737 Opts = opt_al_1(A1, Opts0), 738 A = update_al(A1, E, Opts), 739 {{get_bits,E,Opts},A}; 740opt_al({call,Fun,E0}, A0) -> 741 {E,A} = opt_al(E0, A0), 742 {{call,Fun,E},A}; 743opt_al({convert,Op,E0}, A0) -> 744 {E,A} = opt_al(E0, A0), 745 {{convert,Op,E},A}; 746opt_al({value,V}=Term, A) when is_integer(V); is_atom(V) -> 747 {Term,A}; 748opt_al({value,E0}, A0) -> 749 {E,A} = opt_al(E0, A0), 750 {{value,E},A}; 751opt_al({add,E0,I}, A0) when is_integer(I) -> 752 {E,A} = opt_al(E0, A0), 753 {{add,E,I},A}; 754opt_al({test,E0,V,B0}, A0) -> 755 {E,A1} = opt_al(E0, A0), 756 {B,A2} = opt_al(B0, A1), 757 {{test,E,V,B},A2}; 758opt_al({'case',Cs0}, A0) -> 759 {Cs,A} = opt_al_cs(Cs0, A0), 760 {{'case',Cs},A}; 761opt_al({map,E0,Cs}, A0) -> 762 {E,A} = opt_al(E0, A0), 763 {{map,E,Cs},A}; 764opt_al(I, A) when is_integer(I) -> 765 {I,A}. 766 767opt_al_cs([C0|Cs0], A0) -> 768 {C,A1} = opt_al(C0, A0), 769 {Cs,A2} = opt_al_cs(Cs0, A0), 770 {[C|Cs],merge_al(A1, A2)}; 771opt_al_cs([], _) -> {[],none}. 772 773merge_al(unknown, _) -> unknown; 774merge_al(Other, none) -> Other; 775merge_al(_, unknown) -> unknown; 776merge_al(I0, I1) -> 777 case {I0 rem 8,I1 rem 8} of 778 {I,I} -> I; 779 {_,_} -> unknown 780 end. 781 782opt_al_1(unknown, Opts) -> 783 Opts; 784opt_al_1(A, Opts0) -> 785 case alignment(Opts0) of 786 none -> 787 Opts0; 788 full -> 789 case A rem 8 of 790 0 -> 791 %% Already in alignment. 792 proplists:delete(align, Opts0); 793 Bits -> 794 %% Cheaper alignment with a constant padding. 795 Opts1 = proplists:delete(align, Opts0), 796 [{align,8-Bits }|Opts1] 797 end; 798 A -> %Assertion. 799 Opts0 800 end. 801 802update_al(A0, E, Opts) -> 803 A = case alignment(Opts) of 804 none -> A0; 805 full -> 0; 806 Bits when is_integer(A0) -> 807 0 = (A0 + Bits) rem 8; %Assertion. 808 _ -> 809 0 810 end, 811 [U] = [U || U <- Opts, is_integer(U)], 812 if 813 U rem 8 =:= 0 -> A; 814 is_integer(A), is_integer(E) -> A + U*E; 815 true -> unknown 816 end. 817 818%%% 819%%% Flatten the intermediate format and assign temporaries. 820%%% 821 822flatten({get_bits,I,U}, Buf0, St0) when is_integer(I) -> 823 {Dst,St} = new_var_pair(St0), 824 Gb = {get_bits,{I,Buf0},U,Dst}, 825 flatten_align(Gb, [], St); 826flatten({get_bits,E0,U}, Buf0, St0) -> 827 {E,Pre,St1} = flatten(E0, Buf0, St0), 828 {Dst,St2} = new_var_pair(St1), 829 Gb = {get_bits,E,U,Dst}, 830 flatten_align(Gb, Pre, St2); 831flatten({test,{get_bits,I,U},V,E0}, Buf0, St0) when is_integer(I) -> 832 {DstBuf0,St1} = new_var("Buf", St0), 833 Gb = {get_bits,{I,Buf0},U,{V,DstBuf0}}, 834 {{_Dst,DstBuf},Pre0,St2} = flatten_align(Gb, [], St1), 835 {E,Pre1,St3} = flatten(E0, DstBuf, St2), 836 {E,Pre0++Pre1,St3}; 837flatten({add,E0,I}, Buf0, St0) -> 838 {{Src,Buf},Pre,St1} = flatten(E0, Buf0, St0), 839 {Dst,St} = new_var("Add", St1), 840 {{Dst,Buf},Pre++[{add,Src,I,Dst}],St}; 841flatten({'case',Cs0}, Buf0, St0) -> 842 {Dst,St1} = new_var_pair(St0), 843 {Cs1,St} = flatten_cs(Cs0, Buf0, St1), 844 {Al,Cs2} = flatten_hoist_align(Cs1), 845 {Dst,Al++[{'case',Buf0,Cs2,Dst}],St}; 846flatten({map,E0,Cs0}, Buf0, St0) -> 847 {{E,DstBuf},Pre,St1} = flatten(E0, Buf0, St0), 848 {Dst,St2} = new_var("Int", St1), 849 Cs = flatten_map_cs(Cs0, E), 850 {{Dst,DstBuf},Pre++[{'map',E,Cs,{Dst,DstBuf}}],St2}; 851flatten({value,V}, Buf0, St0) when is_atom(V) -> 852 {{"'"++atom_to_list(V)++"'",Buf0},[],St0}; 853flatten({value,V0}, Buf0, St0) when is_integer(V0) -> 854 {{V0,Buf0},[],St0}; 855flatten({value,V0}, Buf0, St0) -> 856 flatten(V0, Buf0, St0); 857flatten({convert,Op,E0}, Buf0, St0) -> 858 {{E,Buf},Pre,St1} = flatten(E0, Buf0, St0), 859 {Dst,St2} = new_var("Conv", St1), 860 {{Dst,Buf},Pre++[{convert,Op,E,Dst}],St2}; 861flatten({call,Fun,E0}, Buf0, St0) -> 862 {Src,Pre,St1} = flatten(E0, Buf0, St0), 863 {Dst,St2} = new_var_pair(St1), 864 {Dst,Pre++[{call,Fun,Src,Dst}],St2}. 865 866flatten_cs([C0|Cs0], Buf, St0) -> 867 {C,Pre,St1} = flatten(C0, Buf, St0), 868 {Cs,St2} = flatten_cs(Cs0, Buf, St0), 869 St3 = St2#st{var=max(St1#st.var, St2#st.var)}, 870 {[Pre++[{return,C}]|Cs],St3}; 871flatten_cs([], _, St) -> {[],St}. 872 873flatten_map_cs(Cs, Var) -> 874 flatten_map_cs_1(Cs, {Var,Cs}). 875 876flatten_map_cs_1([{K,V}|Cs], DefData) -> 877 [{{asis,K},{asis,V}}|flatten_map_cs_1(Cs, DefData)]; 878flatten_map_cs_1([integer_default], {Int,_}) -> 879 [{'_',Int}]; 880flatten_map_cs_1([enum_default], {Int,_}) -> 881 [{'_',["{asn1_enum,",Int,"}"]}]; 882flatten_map_cs_1([enum_error], {Var,_}) -> 883 [{'_',["exit({error,{asn1,{decode_enumerated,",Var,"}}})"]}]; 884flatten_map_cs_1([], _) -> []. 885 886flatten_hoist_align([[{align_bits,_,_}=Ab|T]|Cs]) -> 887 flatten_hoist_align_1(Cs, Ab, [T]); 888flatten_hoist_align(Cs) -> {[],Cs}. 889 890flatten_hoist_align_1([[Ab|T]|Cs], Ab, Acc) -> 891 flatten_hoist_align_1(Cs, Ab, [T|Acc]); 892flatten_hoist_align_1([], Ab, Acc) -> 893 {[Ab],lists:reverse(Acc)}. 894 895flatten_align({get_bits,{SrcBits,SrcBuf},U,Dst}=Gb0, Pre, St0) -> 896 case alignment(U) of 897 none -> 898 flatten_align_1(U, Dst, Pre++[Gb0], St0); 899 full -> 900 {PadBits,St1} = new_var("Pad", St0), 901 {DstBuf,St2} = new_var("Buf", St1), 902 Ab = {align_bits,SrcBuf,PadBits}, 903 Agb = {get_bits,{PadBits,SrcBuf},[1],{'_',DstBuf}}, 904 Gb = {get_bits,{SrcBits,DstBuf},U,Dst}, 905 flatten_align_1(U, Dst, Pre++[Ab,Agb,Gb], St2); 906 PadBits when is_integer(PadBits), PadBits > 0 -> 907 {DstBuf,St1} = new_var("Buf", St0), 908 Agb = {get_bits,{PadBits,SrcBuf},[1],{'_',DstBuf}}, 909 Gb = {get_bits,{SrcBits,DstBuf},U,Dst}, 910 flatten_align_1(U, Dst, Pre++[Agb,Gb], St1) 911 end. 912 913flatten_align_1(U, {D,_}=Dst, Pre, St) -> 914 case is_non_zero(U) of 915 false -> 916 {Dst,Pre,St}; 917 true -> 918 {Dst,Pre++[{non_zero,D}],St} 919 end. 920 921new_var_pair(St0) -> 922 {Var,St1} = new_var("V", St0), 923 {Buf,St2} = new_var("Buf", St1), 924 {{Var,Buf},St2}. 925 926new_var(Tag, #st{base=VarBase,var=N}=St) -> 927 {VarBase++Tag++integer_to_list(N),St#st{var=N+1}}. 928 929alignment([{align,false}|_]) -> none; 930alignment([{align,true}|_]) -> full; 931alignment([{align,Bits}|_]) -> Bits; 932alignment([_|T]) -> alignment(T); 933alignment([]) -> none. 934 935is_non_zero(Fl) -> 936 lists:member(non_zero, Fl). 937 938%%% 939%%% Generate Erlang code from the flattened intermediate format. 940%%% 941 942dcg_list_outside([{align_bits,Buf,SzVar}|T]) -> 943 emit([SzVar," = bit_size(",Buf,") band 7"]), 944 iter_dcg_list_outside(T); 945dcg_list_outside([{'case',Buf,Cs,Dst}|T]) -> 946 dcg_case(Buf, Cs, Dst), 947 iter_dcg_list_outside(T); 948dcg_list_outside([{'map',Val,Cs,Dst}|T]) -> 949 dcg_map(Val, Cs, Dst), 950 iter_dcg_list_outside(T); 951dcg_list_outside([{add,S1,S2,Dst}|T]) -> 952 emit([Dst," = ",S1," + ",S2]), 953 iter_dcg_list_outside(T); 954dcg_list_outside([{return,{V,Buf}}|T]) -> 955 emit(["{",V,",",Buf,"}"]), 956 iter_dcg_list_outside(T); 957dcg_list_outside([{call,Fun,{V,Buf},{Dst,DstBuf}}|T]) -> 958 emit(["{",Dst,",",DstBuf,"} = "]), 959 Fun(V, Buf), 960 iter_dcg_list_outside(T); 961dcg_list_outside([{convert,{M,F},V,Dst}|T]) -> 962 emit([Dst," = ",{asis,M},":",{asis,F},"(",V,")"]), 963 iter_dcg_list_outside(T); 964dcg_list_outside([{convert,Op,V,Dst}|T]) -> 965 emit([Dst," = ",Op,"(",V,")"]), 966 iter_dcg_list_outside(T); 967dcg_list_outside([{get_bits,{_,Buf0},_,_}|_]=L0) -> 968 emit("<<"), 969 {L,Buf} = dcg_list_inside(L0, buf), 970 emit([Buf,"/bitstring>> = ",Buf0]), 971 iter_dcg_list_outside(L); 972dcg_list_outside([]) -> 973 emit("ignore"), 974 ok. 975 976iter_dcg_list_outside([_|_]=T) -> 977 emit([",",nl]), 978 dcg_list_outside(T); 979iter_dcg_list_outside([]) -> ok. 980 981dcg_case(Buf, Cs, {Dst,DstBuf}) -> 982 emit(["{",Dst,",",DstBuf,"} = case ",Buf," of",nl]), 983 dcg_case_cs(Cs), 984 emit("end"). 985 986dcg_case_cs([C|Cs]) -> 987 emit("<<"), 988 {T0,DstBuf} = dcg_list_inside(C, buf), 989 emit([DstBuf,"/bitstring>>"]), 990 T1 = dcg_guard(T0), 991 dcg_list_outside(T1), 992 case Cs of 993 [] -> emit([nl]); 994 [_|_] -> emit([";",nl]) 995 end, 996 dcg_case_cs(Cs); 997dcg_case_cs([]) -> ok. 998 999dcg_guard([{non_zero,Src}|T]) -> 1000 emit([" when ",Src," =/= 0 ->",nl]), 1001 T; 1002dcg_guard(T) -> 1003 emit([" ->",nl]), 1004 T. 1005 1006dcg_map(Val, Cs, {Dst,_}) -> 1007 emit([Dst," = case ",Val," of",nl]), 1008 dcg_map_cs(Cs), 1009 emit("end"). 1010 1011dcg_map_cs([{K,V}]) -> 1012 emit([K," -> ",V,nl]); 1013dcg_map_cs([{K,V}|Cs]) -> 1014 emit([K," -> ",V,";",nl]), 1015 dcg_map_cs(Cs). 1016 1017dcg_list_inside([{get_bits,{Sz,_},Fl0,{Dst,DstBuf}}|T], _) -> 1018 Fl = bit_flags(Fl0, []), 1019 emit([mk_dest(Dst),":",Sz,Fl,","]), 1020 dcg_list_inside(T, DstBuf); 1021dcg_list_inside(L, Dst) -> {L,Dst}. 1022 1023bit_flags([{align,_}|T], Acc) -> 1024 bit_flags(T, Acc); 1025bit_flags([non_zero|T], Acc) -> 1026 bit_flags(T, Acc); 1027bit_flags([U|T], Acc) when is_integer(U) -> 1028 bit_flags(T, ["unit:"++integer_to_list(U)|Acc]); 1029bit_flags([H|T], Acc) -> 1030 bit_flags(T, [atom_to_list(H)|Acc]); 1031bit_flags([], []) -> 1032 ""; 1033bit_flags([], Acc) -> 1034 case "/" ++ bit_flags_1(Acc, "") of 1035 "/unit:1" -> []; 1036 Opts -> Opts 1037 end. 1038 1039 1040bit_flags_1([H|T], Sep) -> 1041 Sep ++ H ++ bit_flags_1(T, "-"); 1042bit_flags_1([], _) -> []. 1043 1044mk_dest(I) when is_integer(I) -> 1045 integer_to_list(I); 1046mk_dest(S) -> S. 1047 1048%%% 1049%%% Constructing the intermediate format for encoding. 1050%%% 1051 1052split_off_nonbuilding(Imm) -> 1053 lists:splitwith(fun is_nonbuilding/1, Imm). 1054 1055is_nonbuilding({assign,_,_}) -> true; 1056is_nonbuilding({call,_,_,_,_}) -> true; 1057is_nonbuilding({comment,_}) -> true; 1058is_nonbuilding({lc,_,_,_,_}) -> true; 1059is_nonbuilding({set,_,_}) -> true; 1060is_nonbuilding({list,_,_}) -> true; 1061is_nonbuilding({sub,_,_,_}) -> true; 1062is_nonbuilding({'try',_,_,_,_}) -> true; 1063is_nonbuilding(_) -> false. 1064 1065mk_vars(Input0, Temps) -> 1066 asn1ct_name:new(enc), 1067 Curr = asn1ct_name:curr(enc), 1068 [H|T] = atom_to_list(Curr), 1069 Base = [H - ($a - $A)|T ++ "@"], 1070 case Input0 of 1071 {var,Name} when is_list(Name) -> 1072 {[],[Input0|mk_vars_1(Base, Temps)]}; 1073 [] -> 1074 {[],[Input0|mk_vars_1(Base, Temps)]}; 1075 _ when is_integer(Input0) -> 1076 {[],[Input0|mk_vars_1(Base, Temps)]} 1077 end. 1078 1079mk_vars_1(Base, Vars) -> 1080 [mk_var(Base, V) || V <- Vars]. 1081 1082mk_var(Base, V) -> 1083 {var,Base ++ atom_to_list(V)}. 1084 1085per_enc_integer_1(Val, [], Aligned) -> 1086 [{'cond',[['_'|per_enc_unconstrained(Val, Aligned)]]}]; 1087per_enc_integer_1(Val, [{{'SingleValue',[_|_]=Svs}=Constr,[]}], Aligned) -> 1088 %% An extensible constraint such as (1|17, ...). 1089 %% 1090 %% A subtle detail is that the extension root as described in the 1091 %% ASN.1 spec should be used to determine whether a particular value 1092 %% belongs to the extension root (as opposed to the effective 1093 %% constraint, which will be used for the actual encoding). 1094 %% 1095 %% So for the example above, only the integers 1 and 17 should be 1096 %% encoded as root values (extension bit = 0). 1097 1098 [{'ValueRange',{Lb,Ub}}] = effective_constraint(integer, [Constr]), 1099 Root = [begin 1100 {[],_,Put} = per_enc_constrained(Sv, Lb, Ub, Aligned), 1101 [{eq,Val,Sv},{put_bits,0,1,[1]}|Put] 1102 end || Sv <- Svs], 1103 Cs = Root ++ [['_',{put_bits,1,1,[1]}| 1104 per_enc_unconstrained(Val, Aligned)]], 1105 build_cond(Cs); 1106per_enc_integer_1(Val0, [{{_,_}=Constr,[]}], Aligned) -> 1107 {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned), 1108 Prefix++build_cond([[Check,{put_bits,0,1,[1]}|Action], 1109 ['_',{put_bits,1,1,[1]}| 1110 per_enc_unconstrained(Val0, Aligned)]]); 1111per_enc_integer_1(Val0, [Constr], Aligned) -> 1112 {Prefix,Check,Action} = per_enc_integer_2(Val0, Constr, Aligned), 1113 Prefix++build_cond([[Check|Action], 1114 ['_',{error,{illegal_integer,Val0}}]]). 1115 1116per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) -> 1117 per_enc_constrained(Val, Sv, Sv, Aligned); 1118per_enc_integer_2(Val, {'ValueRange',{'MIN',Ub}}, Aligned) 1119 when is_integer(Ub) -> 1120 {[],{lt,Val,Ub+1},per_enc_unconstrained(Val, Aligned)}; 1121per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned) 1122 when is_integer(Lb) -> 1123 {Prefix,Val} = sub_lb(Val0, Lb), 1124 {Prefix,{ge,Val,0},per_enc_unsigned(Val, Aligned)}; 1125per_enc_integer_2(Val, {'ValueRange',{Lb,Ub}}, Aligned) 1126 when is_integer(Lb), is_integer(Ub) -> 1127 per_enc_constrained(Val, Lb, Ub, Aligned). 1128 1129per_enc_constrained(Val, Sv, Sv, _Aligned) -> 1130 {[],{eq,Val,Sv},[]}; 1131per_enc_constrained(Val0, Lb, Ub, false) -> 1132 {Prefix,Val} = sub_lb(Val0, Lb), 1133 Range = Ub - Lb + 1, 1134 NumBits = uper_num_bits(Range), 1135 Check = {ult,Val,Range}, 1136 Put = [{put_bits,Val,NumBits,[1]}], 1137 {Prefix,Check,Put}; 1138per_enc_constrained(Val0, Lb, Ub, true) -> 1139 {Prefix,Val} = sub_lb(Val0, Lb), 1140 Range = Ub - Lb + 1, 1141 Check = {ult,Val,Range}, 1142 if 1143 Range < 256 -> 1144 NumBits = per_num_bits(Range), 1145 Put = [{put_bits,Val,NumBits,[1]}], 1146 {Prefix,Check,Put}; 1147 Range =:= 256 -> 1148 NumBits = 8, 1149 Put = [{put_bits,Val,NumBits,[1,align]}], 1150 {Prefix,Check,Put}; 1151 Range =< 65536 -> 1152 Put = [{put_bits,Val,16,[1,align]}], 1153 {Prefix,Check,Put}; 1154 true -> 1155 RangeOctsLen = byte_size(binary:encode_unsigned(Range - 1)), 1156 BitsNeeded = per_num_bits(RangeOctsLen), 1157 {Prefix,Check,per_enc_constrained_huge(BitsNeeded, Val)} 1158 end. 1159 1160per_enc_constrained_huge(BitsNeeded, {var,VarBase}=Val) -> 1161 Bin = {var,VarBase++"@bin"}, 1162 BinSize0 = {var,VarBase++"@bin_size0"}, 1163 BinSize = {var,VarBase++"@bin_size"}, 1164 [{call,binary,encode_unsigned,[Val],Bin}, 1165 {call,erlang,byte_size,[Bin],BinSize0}, 1166 {sub,BinSize0,1,BinSize}, 1167 {'cond',[['_', 1168 {put_bits,BinSize,BitsNeeded,[1]}, 1169 {put_bits,Bin,binary,[8,align]}]]}]; 1170per_enc_constrained_huge(BitsNeeded, Val) when is_integer(Val) -> 1171 Bin = binary:encode_unsigned(Val), 1172 BinSize = erlang:byte_size(Bin), 1173 [{put_bits,BinSize-1,BitsNeeded,[1]}, 1174 {put_bits,Val,8*BinSize,[1,align]}]. 1175 1176per_enc_unconstrained(Val, Aligned) -> 1177 case Aligned of 1178 false -> []; 1179 true -> [{put_bits,0,0,[1,align]}] 1180 end ++ [{call,per_common,encode_unconstrained_number,[Val]}]. 1181 1182per_enc_unsigned(Val, Aligned) -> 1183 case is_integer(Val) of 1184 false -> 1185 {var,VarBase} = Val, 1186 Bin = {var,VarBase++"@bin"}, 1187 BinSize = {var,VarBase++"@bin_size"}, 1188 [{call,binary,encode_unsigned,[Val],Bin}, 1189 {call,erlang,byte_size,[Bin],BinSize}| 1190 per_enc_length(Bin, 8, BinSize, Aligned)]; 1191 true -> 1192 Bin = binary:encode_unsigned(Val), 1193 Len = byte_size(Bin), 1194 per_enc_length(Bin, 8, Len, Aligned) 1195 end. 1196 1197%% Encode a length field without any constraint. 1198per_enc_length(Bin, Unit, Len, Aligned) -> 1199 U = unit(1, Aligned), 1200 PutBits = put_bits_binary(Bin, Unit, Aligned), 1201 EncFragmented = {call,per_common,encode_fragmented,[Bin,Unit]}, 1202 Al = case Aligned of 1203 false -> []; 1204 true -> [{put_bits,0,0,[1,align]}] 1205 end, 1206 build_cond([[{lt,Len,128}, 1207 {put_bits,Len,8,U},PutBits], 1208 [{lt,Len,16384}, 1209 {put_bits,2,2,U},{put_bits,Len,14,[1]},PutBits], 1210 ['_'|Al++[EncFragmented]]]). 1211 1212per_enc_length(Bin, Unit, Len, no, Aligned, _Type) -> 1213 per_enc_length(Bin, Unit, Len, Aligned); 1214per_enc_length(Bin, Unit, Len, {{Lb,Ub},[]}, Aligned, Type) -> 1215 {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), 1216 NoExt = {put_bits,0,1,[1]}, 1217 U = unit(Unit, Aligned, Type, Lb*Unit, Ub*Unit), 1218 PutBits = [{put_bits,Bin,binary,U}], 1219 [{'cond',ExtConds0}] = per_enc_length(Bin, Unit, Len, Aligned), 1220 Ext = {put_bits,1,1,[1]}, 1221 ExtConds = prepend_to_cond(ExtConds0, Ext), 1222 build_length_cond(Prefix, [[Check,NoExt|PutLen++PutBits]|ExtConds]); 1223per_enc_length(Bin, Unit, Len, {Lb,Ub}, Aligned, Type) 1224 when is_integer(Lb) -> 1225 {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), 1226 U = unit(Unit, Aligned, Type, Lb*Unit, Ub*Unit), 1227 PutBits = [{put_bits,Bin,binary,U}], 1228 build_length_cond(Prefix, [[Check|PutLen++PutBits]]); 1229per_enc_length(Bin, Unit0, Len, Sv, Aligned, Type) when is_integer(Sv) -> 1230 NumBits = Sv*Unit0, 1231 Unit = case NumBits rem 8 of 1232 0 -> 1233 %% Help out the alignment optimizer. 1234 8; 1235 _ -> 1236 Unit0 1237 end, 1238 U = unit(Unit, Aligned, Type, NumBits, NumBits), 1239 Pb = {put_bits,Bin,binary,U}, 1240 [{'cond',[[{eq,Len,Sv},Pb]]}]. 1241 1242enc_length(Len, no, Aligned) -> 1243 U = unit(1, Aligned), 1244 build_cond([[{lt,Len,128}, 1245 {put_bits,Len,8,U}], 1246 [{lt,Len,16384}, 1247 {put_bits,2,2,U},{put_bits,Len,14,[1]}]]); 1248enc_length(Len, {{Lb,Ub},[]}, Aligned) -> 1249 {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), 1250 NoExt = {put_bits,0,1,[1]}, 1251 [{'cond',ExtConds0}] = enc_length(Len, no, Aligned), 1252 Ext = {put_bits,1,1,[1]}, 1253 ExtConds = prepend_to_cond(ExtConds0, Ext), 1254 build_length_cond(Prefix, [[Check,NoExt|PutLen]|ExtConds]); 1255enc_length(Len, {Lb,Ub}, Aligned) when is_integer(Lb) -> 1256 {Prefix,Check,PutLen} = per_enc_constrained(Len, Lb, Ub, Aligned), 1257 build_length_cond(Prefix, [[Check|PutLen]]); 1258enc_length(Len, Sv, _Aligned) when is_integer(Sv) -> 1259 [{'cond',[[{eq,Len,Sv}]]}]. 1260 1261extensions_bitmap(Vs, Undefined) -> 1262 Highest = 1 bsl (length(Vs)-1), 1263 Cs = extensions_bitmap_1(Vs, Undefined, Highest), 1264 lists:flatten(lists:join(" bor ", Cs)). 1265 1266extensions_bitmap_1([{var,V}|Vs], Undefined, Power) -> 1267 S = ["case ",V," of\n", 1268 " ",Undefined," -> 0;\n" 1269 " _ -> ",integer_to_list(Power),"\n" 1270 "end"], 1271 [S|extensions_bitmap_1(Vs, Undefined, Power bsr 1)]; 1272extensions_bitmap_1([], _, _) -> 1273 []. 1274 1275put_bits_binary(Bin, _Unit, Aligned) when is_binary(Bin) -> 1276 Sz = byte_size(Bin), 1277 <<Int:Sz/unit:8>> = Bin, 1278 {put_bits,Int,8*Sz,unit(1, Aligned)}; 1279put_bits_binary(Bin, Unit, Aligned) -> 1280 {put_bits,Bin,binary,unit(Unit, Aligned)}. 1281 1282sub_lb(Val, 0) -> 1283 {[],Val}; 1284sub_lb({var,Var}=Val0, Lb) -> 1285 Val = {var,Var++"@sub"}, 1286 {[{sub,Val0,Lb,Val}],Val}; 1287sub_lb(Val, Lb) when is_integer(Val) -> 1288 {[],Val-Lb}. 1289 1290build_length_cond([{sub,Var0,Base,Var}]=Prefix, Cs) -> 1291 %% Non-zero lower bound, such as: SIZE (50..200, ...) 1292 Prefix++[{'cond',opt_length_nzlb(Cs, {Var0,Var,Base}, 0)}]; 1293build_length_cond([], Cs) -> 1294 %% Zero lower bound, such as: SIZE (0..200, ...) 1295 [{'cond',opt_length_zlb(Cs, 0)}]. 1296 1297opt_length_zlb([[{ult,Var,Val}|Actions]|T], Ub) -> 1298 %% Since the SIZE constraint is zero-based, Var 1299 %% must be greater than zero, and we can use 1300 %% the slightly cheaper signed less than operator. 1301 opt_length_zlb([[{lt,Var,Val}|Actions]|T], Ub); 1302opt_length_zlb([[{lt,_,Val}|_]=H|T], Ub) -> 1303 if 1304 Val =< Ub -> 1305 %% A previous test has already matched. 1306 opt_length_zlb(T, Ub); 1307 true -> 1308 [H|opt_length_zlb(T, max(Ub, Val))] 1309 end; 1310opt_length_zlb([H|T], Ub) -> 1311 [H|opt_length_zlb(T, Ub)]; 1312opt_length_zlb([], _) -> []. 1313 1314opt_length_nzlb([[{ult,Var,Val}|_]=H|T], {_,Var,Base}=St, _Ub) -> 1315 [H|opt_length_nzlb(T, St, Base+Val)]; 1316opt_length_nzlb([[{lt,Var0,Val}|_]=H|T], {Var0,_,_}=St, Ub) -> 1317 if 1318 Val =< Ub -> 1319 %% A previous test has already matched. 1320 opt_length_nzlb(T, St, Ub); 1321 true -> 1322 [H|opt_length_nzlb(T, St, Val)] 1323 end; 1324opt_length_nzlb([H|T], St, Ub) -> 1325 [H|opt_length_nzlb(T, St, Ub)]; 1326opt_length_nzlb([], _, _) -> []. 1327 1328build_cond(Conds0) -> 1329 case eval_cond(Conds0, gb_sets:empty()) of 1330 [['_'|Actions]] -> 1331 Actions; 1332 Conds -> 1333 [{'cond',Conds}] 1334 end. 1335 1336eval_cond([['_',{'cond',Cs}]], Seen) -> 1337 eval_cond(Cs, Seen); 1338eval_cond([[Cond|Actions]=H|T], Seen0) -> 1339 case gb_sets:is_element(Cond, Seen0) of 1340 false -> 1341 Seen = gb_sets:insert(Cond, Seen0), 1342 case eval_cond_1(Cond) of 1343 false -> 1344 eval_cond(T, Seen); 1345 true -> 1346 [['_'|Actions]]; 1347 maybe -> 1348 [H|eval_cond(T, Seen)] 1349 end; 1350 true -> 1351 eval_cond(T, Seen0) 1352 end; 1353eval_cond([], _) -> []. 1354 1355eval_cond_1({ult,I,N}) when is_integer(I), is_integer(N) -> 1356 0 =< I andalso I < N; 1357eval_cond_1({eq,[],[]}) -> 1358 true; 1359eval_cond_1({eq,I,N}) when is_integer(I), is_integer(N) -> 1360 I =:= N; 1361eval_cond_1({ge,I,N}) when is_integer(I), is_integer(N) -> 1362 I >= N; 1363eval_cond_1({lt,I,N}) when is_integer(I), is_integer(N) -> 1364 I < N; 1365eval_cond_1(_) -> maybe. 1366 1367prepend_to_cond([H|T], Code) -> 1368 [prepend_to_cond_1(H, Code)|prepend_to_cond(T, Code)]; 1369prepend_to_cond([], _) -> []. 1370 1371prepend_to_cond_1([Check|T], Code) -> 1372 [Check,Code|T]. 1373 1374enc_char_tab(notab) -> 1375 notab; 1376enc_char_tab(Tab0) -> 1377 Tab1 = tuple_to_list(Tab0), 1378 First = hd(Tab1), 1379 Tab = enc_char_tab_1(Tab1, First, 0), 1380 case lists:member(ill, Tab) of 1381 false -> 1382 {compact_map,{First,tuple_size(Tab0)}}; 1383 true -> 1384 {tab,{First-1,list_to_tuple(Tab)}} 1385 end. 1386 1387enc_char_tab_1([H|T], H, I) -> 1388 [I|enc_char_tab_1(T, H+1, I+1)]; 1389enc_char_tab_1([_|_]=T, H, I) -> 1390 [ill|enc_char_tab_1(T, H+1, I)]; 1391enc_char_tab_1([], _, _) -> []. 1392 1393enumerated_constraint([_]) -> 1394 [{'SingleValue',0}]; 1395enumerated_constraint(Root) -> 1396 [{'ValueRange',{0,length(Root)-1}}]. 1397 1398per_enc_enumerated_root(NNL, Prefix, Val, Constr, Aligned) -> 1399 per_enc_enumerated_root_1(NNL, Prefix, Val, Constr, Aligned, 0). 1400 1401per_enc_enumerated_root_1([{H,_}|T], Prefix, Val, Constr, Aligned, N) -> 1402 [[{eq,Val,H}|Prefix++per_enc_integer_1(N, Constr, Aligned)]| 1403 per_enc_enumerated_root_1(T, Prefix, Val, Constr, Aligned, N+1)]; 1404per_enc_enumerated_root_1([], _, _, _, _, _) -> []. 1405 1406per_enc_enumerated_ext(NNL, Val, Aligned) -> 1407 per_enc_enumerated_ext_1(NNL, Val, Aligned, 0). 1408 1409per_enc_enumerated_ext_1([{H,_}|T], Val, Aligned, N) -> 1410 [[{eq,Val,H},{put_bits,1,1,[1]}|per_enc_small_number(N, Aligned)]| 1411 per_enc_enumerated_ext_1(T, Val, Aligned, N+1)]; 1412per_enc_enumerated_ext_1([], _, _, _) -> []. 1413 1414per_enc_small_length(Val0, Aligned) -> 1415 {Sub,Val} = sub_lb(Val0, 1), 1416 U = unit(1, Aligned), 1417 Sub ++ build_cond([[{lt,Val,64},{put_bits,Val,7,[1]}], 1418 [{lt,Val0,128},{put_bits,1,1,[1]}, 1419 {put_bits,Val0,8,U}], 1420 ['_',{put_bits,1,1,[1]}, 1421 {put_bits,2,2,U},{put_bits,Val0,14,[1]}]]). 1422 1423constr_min_size(no) -> no; 1424constr_min_size({{Lb,_},[]}) when is_integer(Lb) -> Lb; 1425constr_min_size({Lb,_}) when is_integer(Lb) -> Lb; 1426constr_min_size(Sv) when is_integer(Sv) -> Sv. 1427 1428enc_mod(false) -> uper; 1429enc_mod(true) -> per. 1430 1431unit(U, false) -> [U]; 1432unit(U, true) -> [U,align]. 1433 1434unit(U, Aligned, Type, Lb, Ub) -> 1435 case Aligned andalso is_aligned(Type, Lb, Ub) of 1436 true -> [U,align]; 1437 false -> [U] 1438 end. 1439 1440opt_choice(Imm) -> 1441 {Pb,T0} = lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) -> 1442 true; 1443 (_) -> 1444 false 1445 end, Imm), 1446 try 1447 {Prefix,T} = split_off_nonbuilding(T0), 1448 Prefix ++ opt_choice_1(T, Pb) 1449 catch 1450 throw:impossible -> 1451 Imm 1452 end. 1453 1454opt_choice_1([{'cond',Cs0}], Pb) -> 1455 case Cs0 of 1456 [[C|Act]] -> 1457 [{'cond',[[C|Pb++Act]]}]; 1458 [[C|Act],['_',{error,_}]=Error] -> 1459 [{'cond',[[C|Pb++Act],Error]}]; 1460 _ -> 1461 [{'cond',opt_choice_2(Cs0, Pb)}] 1462 end; 1463opt_choice_1(_, _) -> throw(impossible). 1464 1465opt_choice_2([[C|[{put_bits,_,_,_}|_]=Act]|T], Pb) -> 1466 [[C|Pb++Act]|opt_choice_2(T, Pb)]; 1467opt_choice_2([[_,{error,_}]=H|T], Pb) -> 1468 [H|opt_choice_2(T, Pb)]; 1469opt_choice_2([_|_], _) -> 1470 throw(impossible); 1471opt_choice_2([], _) -> []. 1472 1473%%% 1474%%% Optimize list comprehensions (SEQUENCE OF/SET OF). 1475%%% 1476 1477opt_lc([{lc,[{call,erlang,iolist_to_binary,[Var],Bin}, 1478 {call,erlang,byte_size,[Bin],LenVar}, 1479 {'cond',[[{eq,LenVar,Len},{put_bits,Bin,_,[_|Align]}]]}], 1480 Var,Val}]=Lc, LenImm) -> 1481 %% Given a sequence of a fixed length string, such as 1482 %% SEQUENCE OF OCTET STRING (SIZE (4)), attempt to rewrite to 1483 %% a list comprehension that just checks the size, followed by 1484 %% a conversion to binary: 1485 %% 1486 %% _ = [if length(Comp) =:= 4; byte_size(Comp) =:= 4 -> [] end || 1487 %% Comp <- Sof], 1488 %% [align|iolist_to_binary(Sof)] 1489 1490 CheckImm = [{'cond',[[{eq,{expr,"length("++mk_val(Var)++")"},Len}], 1491 [{eq,{expr,"byte_size("++mk_val(Var)++")"},Len}]]}], 1492 Al = case Align of 1493 [] -> 1494 []; 1495 [align] -> 1496 [{put_bits,0,0,[1|Align]}] 1497 end, 1498 case Al =:= [] orelse 1499 is_end_aligned(LenImm) orelse 1500 lb_is_nonzero(LenImm) of 1501 false -> 1502 %% Not possible because an empty SEQUENCE OF would be 1503 %% improperly aligned. Example: 1504 %% 1505 %% SEQUENCE (SIZE (0..3)) OF ... 1506 1507 Lc; 1508 true -> 1509 %% Examples: 1510 %% 1511 %% SEQUENCE (SIZE (1..4)) OF ... 1512 %% (OK because there must be at least one element) 1513 %% 1514 %% SEQUENCE OF ... 1515 %% (OK because the length field will force alignment) 1516 %% 1517 Al ++ [{lc,CheckImm,Var,Val,{var,"_"}}, 1518 {call,erlang,iolist_to_binary,[Val]}] 1519 end; 1520opt_lc([{lc,ElementImm0,V,L}]=Lc, LenImm) -> 1521 %% Attempt to hoist the alignment, putting after the length 1522 %% and before the list comprehension: 1523 %% 1524 %% [Length, 1525 %% align, 1526 %% [Encode(Comp) || Comp <- Sof]] 1527 %% 1528 1529 case enc_opt_al_1(ElementImm0, 0) of 1530 {ElementImm,0} -> 1531 case is_end_aligned(LenImm) orelse 1532 (is_beginning_aligned(ElementImm0) andalso 1533 lb_is_nonzero(LenImm)) of 1534 false -> 1535 %% Examples: 1536 %% 1537 %% SEQUENCE (SIZE (0..3)) OF OCTET STRING 1538 %% (An empty SEQUENCE OF would be improperly aligned) 1539 %% 1540 %% SEQUENCE (SIZE (1..3)) OF OCTET STRING (SIZE (0..4)) 1541 %% (There would be an improper alignment before the 1542 %% first element) 1543 1544 Lc; 1545 true -> 1546 %% Examples: 1547 %% 1548 %% SEQUENCE OF INTEGER 1549 %% SEQUENCE (SIZE (1..4)) OF INTEGER 1550 %% SEQUENCE (SIZE (1..4)) OF INTEGER (0..256) 1551 1552 [{put_bits,0,0,[1,align]},{lc,ElementImm,V,L}] 1553 end; 1554 _ -> 1555 %% Unknown alignment, no alignment, or not aligned at the end. 1556 %% Examples: 1557 %% 1558 %% SEQUENCE OF SomeConstructedType 1559 %% SEQUENCE OF INTEGER (0..15) 1560 1561 Lc 1562 end. 1563 1564is_beginning_aligned([{'cond',Cs}]) -> 1565 lists:all(fun([_|Act]) -> is_beginning_aligned(Act) end, Cs); 1566is_beginning_aligned([{error,_}|_]) -> true; 1567is_beginning_aligned([{put_bits,_,_,U}|_]) -> 1568 case U of 1569 [_,align] -> true; 1570 [_] -> false 1571 end; 1572is_beginning_aligned(Imm0) -> 1573 case split_off_nonbuilding(Imm0) of 1574 {[],_} -> false; 1575 {[_|_],Imm} -> is_beginning_aligned(Imm) 1576 end. 1577 1578is_end_aligned(Imm) -> 1579 case enc_opt_al_1(Imm, unknown) of 1580 {_,0} -> true; 1581 {_,_} -> false 1582 end. 1583 1584lb_is_nonzero([{sub,_,_,_}|_]) -> true; 1585lb_is_nonzero(_) -> false. 1586 1587%%% 1588%%% Attempt to combine two chunks of intermediate code. 1589%%% 1590 1591combine_imms(ImmA0, ImmB0) -> 1592 {Prefix0,ImmA} = split_off_nonbuilding(ImmA0), 1593 {Prefix1,ImmB} = split_off_nonbuilding(ImmB0), 1594 Prefix = Prefix0 ++ Prefix1, 1595 Combined = do_combine(ImmA ++ ImmB, 3.0), 1596 Prefix ++ Combined. 1597 1598do_combine([{error,_}=Imm|_], _Budget) -> 1599 [Imm]; 1600do_combine([{'cond',Cs0}|T], Budget0) -> 1601 Budget = debit(Budget0, num_clauses(Cs0, 0)), 1602 Cs = [[C|do_combine(Act++T, Budget)] || [C|Act] <- Cs0], 1603 [{'cond',Cs}]; 1604do_combine([{put_bits,V,_,_}|_]=L, Budget) when is_integer(V) -> 1605 {Pb,T} = collect_put_bits(L), 1606 do_combine_put_bits(Pb, T,Budget); 1607do_combine(_, _) -> 1608 throw(impossible). 1609 1610do_combine_put_bits(Pb, [], _Budget) -> 1611 Pb; 1612do_combine_put_bits(Pb, [{'cond',Cs0}|T], Budget) -> 1613 Cs = [case Act of 1614 [{error,_}] -> 1615 [C|Act]; 1616 _ -> 1617 [C|do_combine(Pb++Act, Budget)] 1618 end || [C|Act] <- Cs0], 1619 do_combine([{'cond',Cs}|T], Budget); 1620do_combine_put_bits(_, _, _) -> 1621 throw(impossible). 1622 1623debit(Budget0, Alternatives) -> 1624 case Budget0 - math:log2(Alternatives) of 1625 Budget when Budget > 0.0 -> 1626 Budget; 1627 _ -> 1628 throw(impossible) 1629 end. 1630 1631num_clauses([[_,{error,_}]|T], N) -> 1632 num_clauses(T, N); 1633num_clauses([_|T], N) -> 1634 num_clauses(T, N+1); 1635num_clauses([], N) -> N. 1636 1637 1638collect_put_bits(Imm) -> 1639 lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) -> true; 1640 (_) -> false 1641 end, Imm). 1642 1643%%% 1644%%% Simple common subexpression elimination to avoid fetching 1645%%% the same element twice. 1646%%% 1647 1648enc_cse([{call,erlang,element,Args,V}=H|T]) -> 1649 [H|enc_cse_1(T, Args, V)]; 1650enc_cse(Imm) -> Imm. 1651 1652enc_cse_1([{call,erlang,element,Args,Dst}|T], Args, V) -> 1653 [{set,V,Dst}|enc_cse_1(T, Args, V)]; 1654enc_cse_1([{block,Bl}|T], Args, V) -> 1655 [{block,enc_cse_1(Bl, Args, V)}|enc_cse_1(T, Args, V)]; 1656enc_cse_1([H|T], Args, V) -> 1657 [H|enc_cse_1(T, Args, V)]; 1658enc_cse_1([], _, _) -> []. 1659 1660 1661%%% 1662%%% Pre-process the intermediate code to simplify code generation. 1663%%% 1664 1665enc_pre_cg(Imm) -> 1666 enc_pre_cg_1(Imm, outside_list, in_seq). 1667 1668enc_pre_cg_1([], _StL, _StB) -> 1669 nil; 1670enc_pre_cg_1([H], StL, StB) -> 1671 enc_pre_cg_2(H, StL, StB); 1672enc_pre_cg_1([H0|T0], StL, StB) -> 1673 case is_nonbuilding(H0) of 1674 true -> 1675 H = enc_pre_cg_nonbuilding(H0, StL), 1676 Seq = {seq,H,enc_pre_cg_1(T0, StL, in_seq)}, 1677 case StB of 1678 outside_seq -> {block,Seq}; 1679 in_seq -> Seq 1680 end; 1681 false -> 1682 H = enc_pre_cg_2(H0, in_head, outside_seq), 1683 T = enc_pre_cg_1(T0, in_tail, outside_seq), 1684 enc_make_cons(H, T) 1685 end. 1686 1687enc_pre_cg_2(align, StL, _StB) -> 1688 case StL of 1689 in_head -> align; 1690 in_tail -> {cons,align,nil} 1691 end; 1692enc_pre_cg_2({apply,_,_}=Imm, _, _) -> 1693 Imm; 1694enc_pre_cg_2({block,Bl0}, StL, StB) -> 1695 enc_pre_cg_1(Bl0, StL, StB); 1696enc_pre_cg_2({call,_,_,_}=Imm, _, _) -> 1697 Imm; 1698enc_pre_cg_2({call_gen,_,_,_,_,_}=Imm, _, _) -> 1699 Imm; 1700enc_pre_cg_2({'cond',Cs0}, StL, _StB) -> 1701 Cs = [{C,enc_pre_cg_1(Act, StL, outside_seq)} || [C|Act] <- Cs0], 1702 {'cond',Cs}; 1703enc_pre_cg_2({error,_}=E, _, _) -> 1704 E; 1705enc_pre_cg_2({lc,B0,V,L}, StL, _StB) -> 1706 B = enc_pre_cg_1(B0, StL, outside_seq), 1707 {lc,B,V,L}; 1708enc_pre_cg_2({put_bits,V,8,[1]}, StL, _StB) -> 1709 case StL of 1710 in_head -> {integer,V}; 1711 in_tail -> {cons,{integer,V},nil}; 1712 outside_list -> {cons,{integer,V},nil} 1713 end; 1714enc_pre_cg_2({put_bits,V,binary,_}, _StL, _StB) -> 1715 V; 1716enc_pre_cg_2({put_bits,_,_,[_]}=PutBits, _StL, _StB) -> 1717 {binary,[PutBits]}; 1718enc_pre_cg_2({var,_}=Imm, _, _) -> Imm. 1719 1720enc_make_cons({binary,H}, {binary,T}) -> 1721 {binary,H++T}; 1722enc_make_cons({binary,H0}, {cons,{binary,H1},T}) -> 1723 enc_make_cons({binary,H0++H1}, T); 1724enc_make_cons({binary,H}, {cons,{integer,Int},T}) -> 1725 enc_make_cons({binary,H++[{put_bits,Int,8,[1]}]}, T); 1726enc_make_cons({integer,Int}, {binary,T}) -> 1727 {binary,[{put_bits,Int,8,[1]}|T]}; 1728enc_make_cons({integer,Int}, {cons,{binary,H},T}) -> 1729 enc_make_cons({binary,[{put_bits,Int,8,[1]}|H]}, T); 1730enc_make_cons(H, T) -> 1731 {cons,H,T}. 1732 1733enc_pre_cg_nonbuilding({lc,B0,Var,List,Dst}, StL) -> 1734 B = enc_pre_cg_1(B0, StL, outside_seq), 1735 {lc,B,Var,List,Dst}; 1736enc_pre_cg_nonbuilding({list,List0,Dst}, _StL) -> 1737 List = enc_pre_cg_1(List0, outside_list, outside_seq), 1738 {list,List,Dst}; 1739enc_pre_cg_nonbuilding({'try',Try0,{P,Succ0},Else0,Dst}, StL) -> 1740 Try = enc_pre_cg_1(Try0, StL, outside_seq), 1741 Succ = enc_pre_cg_1(Succ0, StL, outside_seq), 1742 Else = enc_pre_cg_1(Else0, StL, outside_seq), 1743 {'try',Try,{P,Succ},Else,Dst}; 1744enc_pre_cg_nonbuilding(Imm, _) -> Imm. 1745 1746%%% 1747%%% Optimize calls to complete/1 and surrounding code. There are 1748%%% several opportunities for optimizations. 1749%%% 1750%%% It may be possible to replace the call to complete/1 with 1751%%% something cheaper (most important for the PER back-end which has 1752%%% an expensive complete/1 implementation). If we can be sure that 1753%%% complete/1 will be called with an iolist (no 'align' atoms or 1754%%% bitstrings in the list), we can call iolist_to_binary/1 1755%%% instead. If the list may include bitstrings, we can can call 1756%%% list_to_bitstring/1 (note that list_to_bitstring/1 does not accept 1757%%% a binary or bitstring, so we MUST be sure that we only pass it a 1758%%% list). If complete/1 is called with a binary, we can omit the 1759%%% call altogether. 1760%%% 1761%%% A call to byte_size/1 that follows complete/1 can be eliminated 1762%%% if the size of the binary produced by complete/1 can be determined 1763%%% and is constant. 1764%%% 1765%%% The code that encodes the length descriptor (a 'cond' instruction) 1766%%% for a binary produced by complete/1 can be simplified if the lower 1767%%% and upper bounds for the size of the binary are known. 1768%%% 1769 1770-record(ost, 1771 {sym, 1772 t 1773 }). 1774 1775enc_opt(Imm0) -> 1776 {Imm,_} = enc_opt(Imm0, #ost{sym=gb_trees:empty()}), 1777 Imm. 1778 1779enc_opt(align, St) -> 1780 {align,St#ost{t=t_align({0,7})}}; 1781enc_opt({apply,What,As}, St) -> 1782 {{apply,What,subst_list(As, St)},St#ost{t=t_any()}}; 1783enc_opt({assign,_,_}=Imm, St) -> 1784 {Imm,St}; 1785enc_opt({binary,PutBits0}, St) -> 1786 PutBits = [{put_bits,subst(V, St),Sz,F} || 1787 {put_bits,V,Sz,F} <- PutBits0], 1788 NumBits = lists:foldl(fun({put_bits,_,Bits,_}, Sum) -> 1789 Sum+Bits 1790 end, 0, PutBits), 1791 {{binary,PutBits},St#ost{t=t_bitstring(NumBits)}}; 1792enc_opt({block,Bl0}, St0) -> 1793 {Bl,St} = enc_opt(Bl0, St0), 1794 {{block,Bl},St}; 1795enc_opt({call,binary,encode_unsigned,[Int],Bin}=Imm, St0) -> 1796 Type = get_type(Int, St0), 1797 St = case t_range(Type) of 1798 any -> 1799 set_type(Bin, t_binary(), St0); 1800 {Lb0,Ub0} -> 1801 Lb = bit_size(binary:encode_unsigned(Lb0)), 1802 Ub = bit_size(binary:encode_unsigned(Ub0)), 1803 set_type(Bin, t_binary({Lb,Ub}), St0) 1804 end, 1805 {Imm,St}; 1806enc_opt({call,erlang,bit_size,[Bin],Dst}=Imm0, St0) -> 1807 Type = get_type(Bin, St0), 1808 case t_range(Type) of 1809 any -> 1810 St1 = set_type(Bin, t_bitstring(), St0), 1811 St = propagate(Dst, 1812 fun(T, S) -> 1813 bit_size_propagate(Bin, T, S) 1814 end, St1), 1815 {Imm0,St}; 1816 {Lb,Ub}=Range -> 1817 St = set_type(Dst, t_integer(Range), St0), 1818 Imm = case Lb of 1819 Ub -> none; 1820 _ -> Imm0 1821 end, 1822 {Imm,St} 1823 end; 1824enc_opt({call,erlang,byte_size,[Bin],Dst}=Imm0, St0) -> 1825 Type = get_type(Bin, St0), 1826 case t_range(Type) of 1827 any -> 1828 St1 = set_type(Bin, t_binary(), St0), 1829 St = propagate(Dst, 1830 fun(T, S) -> 1831 byte_size_propagate(Bin, T, S) 1832 end, St1), 1833 {Imm0,St}; 1834 {Lb0,Ub0} -> 1835 Lb = (Lb0+7) div 8, 1836 Ub = (Ub0+7) div 8, 1837 St = set_type(Dst, t_integer({Lb,Ub}), St0), 1838 Imm = case Lb of 1839 Ub -> none; 1840 _ -> Imm0 1841 end, 1842 {Imm,St} 1843 end; 1844enc_opt({call,erlang,iolist_to_binary,_}=Imm, St) -> 1845 {Imm,St#ost{t=t_binary()}}; 1846enc_opt({call,erlang,length,[List],Dst}=Imm0, St0) -> 1847 St1 = propagate(Dst, 1848 fun(T, S) -> 1849 length_propagate(List, T, S) 1850 end, St0), 1851 {Imm0,St1}; 1852enc_opt({call,per,complete,[Data],Dst}, St0) -> 1853 Type = get_type(Data, St0), 1854 St = set_type(Dst, t_binary(t_range(Type)), St0), 1855 case t_type(Type) of 1856 binary -> 1857 {{set,Data,Dst},St}; 1858 bitlist -> 1859 %% We KNOW that list_to_bitstring/1 will construct 1860 %% a binary (the number of bits is divisible by 8) 1861 %% because per_enc_open_type/2 added an 'align' atom 1862 %% at the end. If that 'align' atom had not been 1863 %% optimized away, the type would have been 'align' 1864 %% instead of 'bitlist'. 1865 {{call,erlang,list_to_bitstring,[Data],Dst},St}; 1866 iolist -> 1867 {{call,erlang,iolist_to_binary,[Data],Dst},St}; 1868 nil -> 1869 Imm = {list,{binary,[{put_bits,0,8,[1]}]},Dst}, 1870 enc_opt(Imm, St0); 1871 _ -> 1872 {{call,per,complete,[Data],Dst},St} 1873 end; 1874enc_opt({call,uper,complete,[Data],Dst}, St0) -> 1875 Type = get_type(Data, St0), 1876 St = set_type(Dst, t_binary(t_range(Type)), St0), 1877 case t_type(Type) of 1878 binary -> 1879 {{set,Data,Dst},St0}; 1880 iolist -> 1881 {{call,erlang,iolist_to_binary,[Data],Dst},St}; 1882 nil -> 1883 Imm = {list,{binary,[{put_bits,0,8,[1]}]},Dst}, 1884 enc_opt(Imm, St0); 1885 _ -> 1886 %% 'bitlist' or 'any'. 1887 {{call,uper,complete,[Data],Dst},St} 1888 end; 1889enc_opt({call,per_common,encode_chars,[List,NumBits|_],Dst}=Imm, St0) -> 1890 %% Note: Never used when NumBits =:= 8 (list_to_binary/1 will 1891 %% be used instead). 1892 St1 = set_type(Dst, t_bitstring(), St0), 1893 St = propagate(List, 1894 fun(T, S) -> 1895 char_propagate(Dst, T, NumBits, S) 1896 end, St1), 1897 {Imm,St}; 1898enc_opt({call,per_common,encode_chars_16bit,[List],Dst}=Imm, St0) -> 1899 St1 = set_type(Dst, t_binary(), St0), 1900 St = propagate(List, 1901 fun(T, S) -> 1902 char_propagate(Dst, T, 16, S) 1903 end, St1), 1904 {Imm,St}; 1905enc_opt({call,per_common,encode_big_chars,[List],Dst}=Imm, St0) -> 1906 St1 = set_type(Dst, t_binary(), St0), 1907 St = propagate(List, 1908 fun(T, S) -> 1909 char_propagate(Dst, T, 32, S) 1910 end, St1), 1911 {Imm,St}; 1912enc_opt({call,per_common,encode_fragmented,[_,Unit]}=Imm, St) -> 1913 T = case Unit rem 8 of 1914 0 -> t_iolist(); 1915 _ -> t_bitlist() 1916 end, 1917 {Imm,St#ost{t=T}}; 1918enc_opt({call,per_common,encode_unconstrained_number,_}=Imm, St) -> 1919 {Imm,St#ost{t=t_iolist()}}; 1920enc_opt({call,per_common,bitstring_from_positions,_}=Imm, St) -> 1921 {Imm,St#ost{t=t_bitstring()}}; 1922enc_opt({call,per_common,to_named_bitstring,_}=Imm, St) -> 1923 {Imm,St#ost{t=t_bitstring()}}; 1924enc_opt({call,_,_,_}=Imm, St) -> 1925 {Imm,St#ost{t=t_any()}}; 1926enc_opt({call,_,_,_,_}=Imm, St) -> 1927 {Imm,St#ost{t=undefined}}; 1928enc_opt({call_gen,N,K,F,L,As}, St) -> 1929 {{call_gen,N,K,F,L,subst(As, St)},St#ost{t=t_any()}}; 1930enc_opt({'cond',Cs0}, St0) -> 1931 case enc_opt_cs(Cs0, St0) of 1932 [{'_',Imm,Type}] -> 1933 {Imm,St0#ost{t=Type}}; 1934 [{Cond,Imm,Type0}|Cs1] -> 1935 {Cs,Type} = enc_opt_cond_1(Cs1, Type0, [{Cond,Imm}]), 1936 {{'cond',Cs},St0#ost{t=Type}} 1937 end; 1938enc_opt({comment,_}=Imm, St) -> 1939 {Imm,St#ost{t=undefined}}; 1940enc_opt({cons,H0,T0}, St0) -> 1941 {H,#ost{t=TypeH}=St1} = enc_opt(H0, St0), 1942 {T,#ost{t=TypeT}=St} = enc_opt(T0, St1), 1943 {{cons,H,T},St#ost{t=t_cons(TypeH, TypeT)}}; 1944enc_opt({error,_}=Imm, St) -> 1945 {Imm,St#ost{t=t_any()}}; 1946enc_opt({integer,V}, St) -> 1947 {{integer,subst(V, St)},St#ost{t=t_integer()}}; 1948enc_opt({lc,E0,B,C}, St) -> 1949 {E,_} = enc_opt(E0, St), 1950 {{lc,E,B,C},St#ost{t=t_any()}}; 1951enc_opt({lc,E0,B,C,Dst}, St) -> 1952 {E,_} = enc_opt(E0, St), 1953 {{lc,E,B,C,Dst},St#ost{t=undefined}}; 1954enc_opt({list,Imm0,Dst}, St0) -> 1955 {Imm,#ost{t=Type}=St1} = enc_opt(Imm0, St0), 1956 St = set_type(Dst, Type, St1), 1957 {{list,Imm,Dst},St#ost{t=undefined}}; 1958enc_opt(nil, St) -> 1959 {nil,St#ost{t=t_nil()}}; 1960enc_opt({seq,H0,T0}, St0) -> 1961 {H,St1} = enc_opt(H0, St0), 1962 {T,St} = enc_opt(T0, St1), 1963 {enc_opt_seq(H, T),St}; 1964enc_opt({set,_,_}=Imm, St) -> 1965 {Imm,St#ost{t=undefined}}; 1966enc_opt({sub,Src0,Int,Dst}, St0) -> 1967 Src = subst(Src0, St0), 1968 Type = get_type(Src, St0), 1969 St = case t_range(Type) of 1970 any -> 1971 propagate(Dst, 1972 fun(T, S) -> 1973 set_type(Src, t_add(T, Int), S) 1974 end, 1975 St0); 1976 {Lb,Ub} -> 1977 set_type(Dst, t_integer({Lb-Int,Ub-Int}), St0) 1978 end, 1979 {{sub,Src,Int,Dst},St#ost{t=undefined}}; 1980enc_opt({'try',Try0,{P,Succ0},Else0,Dst}, St0) -> 1981 {Try,_} = enc_opt(Try0, St0), 1982 {Succ,_} = enc_opt(Succ0, St0), 1983 {Else,_} = enc_opt(Else0, St0), 1984 {{'try',Try,{P,Succ},Else,Dst},St0#ost{t=undefined}}; 1985enc_opt({var,_}=Imm, St) -> 1986 Type = get_type(Imm, St), 1987 {subst(Imm, St),St#ost{t=Type}}. 1988 1989remove_trailing_align({block,Bl}) -> 1990 {block,remove_trailing_align(Bl)}; 1991remove_trailing_align({cons,H,{cons,align,nil}}) -> 1992 H; 1993remove_trailing_align({seq,H,T}) -> 1994 {seq,H,remove_trailing_align(T)}; 1995remove_trailing_align(Imm) -> Imm. 1996 1997enc_opt_seq(none, T) -> 1998 T; 1999enc_opt_seq({list,Imm,Data}, {seq,{call,per,complete,[Data],_},_}=T) -> 2000 %% Get rid of any explicit 'align' added by per_enc_open_type/2. 2001 {seq,{list,remove_trailing_align(Imm),Data},T}; 2002enc_opt_seq({call,_,_,_,{var,_}=Dst}=H, T) -> 2003 case is_var_unused(Dst, T) of 2004 false -> {seq,H,T}; 2005 true -> T 2006 end; 2007enc_opt_seq(H, T) -> 2008 {seq,H,T}. 2009 2010is_var_unused(_, align) -> 2011 true; 2012is_var_unused(V, {call,_,_,Args}) -> 2013 not lists:member(V, Args); 2014is_var_unused(V, {cons,H,T}) -> 2015 is_var_unused(V, H) andalso is_var_unused(V, T); 2016is_var_unused(_, _) -> 2017 false. 2018 2019bit_size_propagate(Bin, Type, St) -> 2020 case t_range(Type) of 2021 any -> 2022 St; 2023 {Lb,Ub} -> 2024 set_type(Bin, t_bitstring({Lb,Ub}), St) 2025 end. 2026 2027byte_size_propagate(Bin, Type, St) -> 2028 case t_range(Type) of 2029 any -> 2030 St; 2031 {Lb,Ub} -> 2032 set_type(Bin, t_binary({Lb*8,Ub*8}), St) 2033 end. 2034 2035char_propagate(Dst, T, NumBits, St) -> 2036 case t_range(T) of 2037 any -> 2038 St; 2039 {Sz,Sz} when Sz*NumBits rem 8 =:= 0 -> 2040 Bits = Sz*NumBits, 2041 set_type(Dst, t_binary({Bits,Bits}), St); 2042 {Lb,Ub} -> 2043 Range = {Lb*NumBits,Ub*NumBits}, 2044 case NumBits rem 8 of 2045 0 -> 2046 set_type(Dst, t_binary(Range), St); 2047 _ -> 2048 set_type(Dst, t_bitstring(Range), St) 2049 end 2050 end. 2051 2052length_propagate(List, Type, St) -> 2053 set_type(List, t_list(t_range(Type)), St). 2054 2055enc_opt_cond_1([{Cond,{error,_}=Imm,_}|T], St, Acc) -> 2056 enc_opt_cond_1(T, St, [{Cond,Imm}|Acc]); 2057enc_opt_cond_1([{Cond,Imm,Curr0}|T], Curr1, Acc) -> 2058 Curr = t_join(Curr0, Curr1), 2059 enc_opt_cond_1(T, Curr, [{Cond,Imm}|Acc]); 2060enc_opt_cond_1([], St, Acc) -> 2061 {lists:reverse(Acc),St}. 2062 2063enc_opt_cs([{Cond,Imm0}|T], St0) -> 2064 case eo_eval_cond(Cond, St0) of 2065 false -> 2066 enc_opt_cs(T, St0); 2067 true -> 2068 {Imm,#ost{t=Type}} = enc_opt(Imm0, St0), 2069 [{'_',Imm,Type}]; 2070 maybe -> 2071 St = update_type_info(Cond, St0), 2072 {Imm,#ost{t=Type}} = enc_opt(Imm0, St), 2073 [{Cond,Imm,Type}|enc_opt_cs(T, St0)] 2074 end; 2075enc_opt_cs([], _) -> []. 2076 2077eo_eval_cond('_', _) -> 2078 true; 2079eo_eval_cond({Op,{var,_}=Var,Val}, St) -> 2080 Type = get_type(Var, St), 2081 case t_range(Type) of 2082 any -> maybe; 2083 {_,_}=Range -> eval_cond_range(Op, Range, Val) 2084 end; 2085eo_eval_cond({_Op,{expr,_},_Val}, _St) -> maybe. 2086 2087eval_cond_range(lt, {Lb,Ub}, Val) -> 2088 if 2089 Ub < Val -> true; 2090 Val =< Lb -> false; 2091 true -> maybe 2092 end; 2093eval_cond_range(_Op, _Range, _Val) -> maybe. 2094 2095update_type_info({ult,{var,_}=Var,Val}, St) -> 2096 Int = t_integer({0,Val-1}), 2097 Type = t_meet(get_type(Var, St), Int), 2098 set_type(Var, Type, St); 2099update_type_info({lt,{var,_}=Var,Val}, St) -> 2100 Int = t_integer({0,Val-1}), 2101 Type = t_meet(get_type(Var, St), Int), 2102 set_type(Var, Type, St); 2103update_type_info({eq,{var,_}=Var,Val}, St) when is_integer(Val) -> 2104 Int = t_integer(Val), 2105 Type = t_meet(get_type(Var, St), Int), 2106 set_type(Var, Type, St); 2107update_type_info({eq,_,_}, St) -> 2108 St; 2109update_type_info({ge,_,_}, St) -> St. 2110 2111subst_list(As, St) -> 2112 [subst(A, St) || A <- As]. 2113 2114subst({var,_}=Var, St) -> 2115 Type = get_type(Var, St), 2116 case t_type(Type) of 2117 integer -> 2118 case t_range(Type) of 2119 any -> Var; 2120 {Val,Val} -> Val; 2121 {_,_} -> Var 2122 end; 2123 _ -> 2124 Var 2125 end; 2126subst(V, _St) -> V. 2127 2128set_type({var,Var}, {_,_}=Type, #ost{sym=Sym0}=St0) -> 2129 Sym1 = gb_trees:enter(Var, Type, Sym0), 2130 case gb_trees:lookup({propagate,Var}, Sym1) of 2131 none -> 2132 St0#ost{sym=Sym1}; 2133 {value,Propagate} -> 2134 Sym = gb_trees:delete({propagate,Var}, Sym1), 2135 St = St0#ost{sym=Sym}, 2136 Propagate(Type, St) 2137 end. 2138 2139get_type({var,V}, #ost{sym=Sym}) -> 2140 case gb_trees:lookup(V, Sym) of 2141 none -> t_any(); 2142 {value,T} -> T 2143 end. 2144 2145propagate({var,Var}, Propagate, #ost{sym=Sym0}=St) when is_function(Propagate, 2) -> 2146 Sym = gb_trees:enter({propagate,Var}, Propagate, Sym0), 2147 St#ost{sym=Sym}. 2148 2149%%% 2150%%% A simple type system. 2151%%% 2152%%% Each type descriptions is a tuple {Type,Range}. 2153%%% Type is one of the following atoms: 2154%%% 2155%%% Type name Description 2156%%% --------- ----------- 2157%%% any Anything. 2158%%% 2159%%% align Basically iodata, but the list may contain bitstrings 2160%%% and the the atom 'align'. Can be passed to complete/1 2161%%% to construct a binary. Only used for aligned PER (per). 2162%%% 2163%%% bitstring An Erlang bitstring. 2164%%% 2165%%% bitlist A list that may be passed to list_to_bitstring/1 to 2166%%% construct a bitstring. 2167%%% NOTE: When analysing aligned PER (per), the number 2168%%% of bits in the bitlist is always divisible by 8 (if 2169%%% not, the type will be 'align' instead). 2170%%% 2171%%% binary An Erlang binary (the number of bits is divisible by 8). 2172%%% 2173%%% iolist An Erlang iolist. 2174%%% 2175%%% nil [] 2176%%% 2177%%% integer An integer. 2178%%% 2179%%% 2180%%% Range is one of: 2181%%% 2182%%% any 2183%%% {LowerBound,UpperBound} 2184%%% 2185%%% 2186 2187t_align(Range) -> 2188 {align,t__range(Range)}. 2189 2190t_any() -> 2191 {any,any}. 2192 2193t_binary() -> 2194 {binary,any}. 2195 2196t_binary(Range) -> 2197 {binary,t__range(Range)}. 2198 2199t_bitlist() -> 2200 {bitlist,any}. 2201 2202t_bitstring() -> 2203 {bitstring,any}. 2204 2205t_bitstring(Range0) -> 2206 case t__range(Range0) of 2207 {Bits,Bits}=Range when Bits rem 8 =:= 0 -> 2208 {binary,Range}; 2209 Range -> 2210 {bitstring,Range} 2211 end. 2212 2213t_add({integer,{Lb,Ub}}, N) -> 2214 {integer,{Lb+N,Ub+N}}. 2215 2216t_cons({_,_}=T1, {_,_}=T2) -> 2217 T = case {t__cons_type(T1),t__cons_type(T2)} of 2218 {_,any} -> any; 2219 {any,_} -> any; 2220 {align,_} -> align; 2221 {_,align} -> align; 2222 {binary,binary} -> iolist; 2223 {binary,bitstring} -> bitlist; 2224 {bitstring,binary} -> bitlist; 2225 {bitstring,bitstring} -> bitlist 2226 end, 2227 {T,t__cons_ranges(t__cons_range(T1), t__cons_range(T2))}. 2228 2229t_integer() -> 2230 {integer,any}. 2231 2232t_integer(Range) -> 2233 {integer,t__range(Range)}. 2234 2235t_iolist() -> 2236 {iolist,any}. 2237 2238t_list(Range) -> 2239 {list,t__range(Range)}. 2240 2241t_nil() -> 2242 {nil,{0,0}}. 2243 2244t_meet({T1,Range1}, {T2,Range2}) -> 2245 {t_meet_types(T1, T2),t_meet_ranges(Range1, Range2)}. 2246 2247t_meet_types(integer, integer) -> integer; 2248t_meet_types(any, integer) -> integer. 2249 2250t_meet_ranges(any, Range) -> 2251 Range; 2252t_meet_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> 2253 if 2254 Lb1 =< Ub2, Lb2 =< Ub1 -> 2255 {max(Lb1, Lb2),Ub1}; 2256 Lb2 =< Ub1, Lb1 =< Ub2 -> 2257 {max(Lb1, Lb2),Ub2} 2258 end. 2259 2260t_join({T1,Range1}, {T2,Range2}) -> 2261 T = t_join_types(lists:sort([T1,T2])), 2262 Range = t_join_ranges(Range1, Range2), 2263 {T,Range}. 2264 2265t_join_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> 2266 {min(Lb1, Lb2),max(Ub1, Ub2)}; 2267t_join_ranges(any, _) -> any; 2268t_join_ranges(_, any) -> any. 2269 2270t_join_types([T,T]) -> T; 2271t_join_types([align,any]) -> any; 2272t_join_types([align,_]) -> align; 2273t_join_types([any,_]) -> any; 2274t_join_types([bitlist,bitstring]) -> any; 2275t_join_types([bitlist,integer]) -> any; 2276t_join_types([bitlist,iolist]) -> bitlist; 2277t_join_types([bitlist,nil]) -> bitlist; 2278t_join_types([binary,bitlist]) -> bitlist; 2279t_join_types([binary,bitstring]) -> bitstring; 2280t_join_types([binary,integer]) -> binary; 2281t_join_types([binary,iolist]) -> iolist; 2282t_join_types([binary,nil]) -> iolist; 2283t_join_types([bitstring,integer]) -> any; 2284t_join_types([bitstring,iolist]) -> any; 2285t_join_types([bitstring,nil]) -> any; 2286t_join_types([integer,_]) -> any; 2287t_join_types([iolist,nil]) -> iolist. 2288 2289t_type({T,_}) -> T. 2290 2291t_range({_,Range}) -> Range. 2292 2293t__cons_type({align,_}) -> align; 2294t__cons_type({any,_}) -> any; 2295t__cons_type({binary,_}) -> binary; 2296t__cons_type({bitstring,_}) -> bitstring; 2297t__cons_type({bitlist,_}) -> bitstring; 2298t__cons_type({integer,_}) -> binary; 2299t__cons_type({iolist,_}) -> binary; 2300t__cons_type({nil,_}) -> binary. 2301 2302t__cons_range({integer,_}) -> {8,8}; 2303t__cons_range({_,Range}) -> Range. 2304 2305t__cons_ranges({Lb1,Ub1}, {Lb2,Ub2}) -> 2306 {Lb1+Lb2,Ub1+Ub2}; 2307t__cons_ranges(any, _) -> any; 2308t__cons_ranges(_, any) -> any. 2309 2310t__range({Lb,Ub}=Range) when is_integer(Lb), is_integer(Ub) -> 2311 Range; 2312t__range(any) -> 2313 any; 2314t__range(Val) when is_integer(Val) -> 2315 {Val,Val}. 2316 2317 2318%%% 2319%%% Code generation for encoding. 2320%%% 2321 2322enc_cg({cons,_,_}=Cons) -> 2323 enc_cg_cons(Cons); 2324enc_cg({block,Imm}) -> 2325 emit(["begin",nl]), 2326 enc_cg(Imm), 2327 emit([nl, 2328 "end"]); 2329enc_cg({seq,{comment,Comment},Then}) -> 2330 emit(["%% ",Comment,nl]), 2331 enc_cg(Then); 2332enc_cg({seq,First,Then}) -> 2333 enc_cg(First), 2334 emit([com,nl]), 2335 enc_cg(Then); 2336enc_cg(align) -> 2337 emit(align); 2338enc_cg({apply,F0,As0}) -> 2339 As = enc_call_args(As0, ""), 2340 case F0 of 2341 {local,F,_} when is_atom(F) -> 2342 emit([{asis,F},"(",As,")"]); 2343 {M,F,_} -> 2344 emit([{asis,M},":",{asis,F},"(",As,")"]) 2345 end; 2346enc_cg({assign,Dst0,Expr}) -> 2347 Dst = mk_val(Dst0), 2348 emit([Dst," = ",Expr]); 2349enc_cg({binary,PutBits}) -> 2350 emit(["<<",enc_cg_put_bits(PutBits, ""),">>"]); 2351enc_cg({call,M,F,As0}) -> 2352 As = [mk_val(A) || A <- As0], 2353 asn1ct_func:call(M, F, As); 2354enc_cg({call,M,F,As0,Dst}) -> 2355 As = [mk_val(A) || A <- As0], 2356 emit([mk_val(Dst)," = "]), 2357 asn1ct_func:call(M, F, As); 2358enc_cg({call_gen,Prefix,Key,Gen,_,As0}) -> 2359 As = [mk_val(A) || A <- As0], 2360 asn1ct_func:call_gen(Prefix, Key, Gen, As); 2361enc_cg({'cond',Cs}) -> 2362 enc_cg_cond(Cs); 2363enc_cg({error,Error}) when is_function(Error, 0) -> 2364 Error(); 2365enc_cg({error,{Tag,Var0}}) -> 2366 Var = mk_val(Var0), 2367 emit(["exit({error,{asn1,{",Tag,",",Var,"}}})"]); 2368enc_cg({integer,Int}) -> 2369 emit(mk_val(Int)); 2370enc_cg({lc,Body,Var,List}) -> 2371 emit("["), 2372 enc_cg(Body), 2373 emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]); 2374enc_cg({lc,Body,Var,List,Dst}) -> 2375 emit([mk_val(Dst)," = ["]), 2376 enc_cg(Body), 2377 emit([" || ",mk_val(Var)," <- ",mk_val(List),"]"]); 2378enc_cg({list,List,Dst}) -> 2379 emit([mk_val(Dst)," = "]), 2380 enc_cg(List); 2381enc_cg(nil) -> 2382 emit("[]"); 2383enc_cg({sub,Src0,Int,Dst0}) -> 2384 Src = mk_val(Src0), 2385 Dst = mk_val(Dst0), 2386 emit([Dst," = ",Src," - ",Int]); 2387enc_cg({set,{var,Src},{var,Dst}}) -> 2388 emit([Dst," = ",Src]); 2389enc_cg({'try',Try,{P,Succ},Else,Dst}) -> 2390 emit([mk_val(Dst)," = try "]), 2391 enc_cg(Try), 2392 emit([" of",nl, 2393 mk_val(P)," ->",nl]), 2394 enc_cg(Succ), 2395 emit([nl, 2396 "catch throw:invalid ->",nl]), 2397 enc_cg(Else), 2398 emit([nl, 2399 "end"]); 2400enc_cg({var,V}) -> 2401 emit(V). 2402 2403enc_cg_cons(Cons) -> 2404 emit("["), 2405 enc_cg_cons_1(Cons), 2406 emit("]"). 2407 2408enc_cg_cons_1({cons,H,{cons,_,_}=T}) -> 2409 enc_cg(H), 2410 emit([com,nl]), 2411 enc_cg_cons_1(T); 2412enc_cg_cons_1({cons,H,nil}) -> 2413 enc_cg(H); 2414enc_cg_cons_1({cons,H,T}) -> 2415 enc_cg(H), 2416 emit("|"), 2417 enc_cg(T). 2418 2419enc_call_args([A|As], Sep) -> 2420 [Sep,mk_val(A)|enc_call_args(As, ", ")]; 2421enc_call_args([], _) -> []. 2422 2423enc_cg_cond(Cs) -> 2424 emit("if "), 2425 enc_cg_cond(Cs, ""), 2426 emit([nl, 2427 "end"]). 2428 2429enc_cg_cond([C|Cs], Sep) -> 2430 emit(Sep), 2431 enc_cg_cond_1(C), 2432 enc_cg_cond(Cs, [";",nl]); 2433enc_cg_cond([], _) -> ok. 2434 2435enc_cg_cond_1({Cond,Action}) -> 2436 enc_cond_term(Cond), 2437 emit([" ->",nl]), 2438 enc_cg(Action). 2439 2440enc_cond_term('_') -> 2441 emit("true"); 2442enc_cond_term({ult,Var0,Int}) -> 2443 Var = mk_val(Var0), 2444 N = uper_num_bits(Int), 2445 case 1 bsl N of 2446 Int -> 2447 emit([Var," bsr ",N," =:= 0"]); 2448 _ -> 2449 emit(["0 =< ",Var,", ",Var," < ",Int]) 2450 end; 2451enc_cond_term({eq,Var0,Term}) -> 2452 Var = mk_val(Var0), 2453 emit([Var," =:= ",{asis,Term}]); 2454enc_cond_term({ge,Var0,Int}) -> 2455 Var = mk_val(Var0), 2456 emit([Var," >= ",Int]); 2457enc_cond_term({lt,Var0,Int}) -> 2458 Var = mk_val(Var0), 2459 emit([Var," < ",Int]). 2460 2461enc_cg_put_bits([{put_bits,Val0,N,[1]}|T], Sep) -> 2462 Val = mk_val(Val0), 2463 [[Sep,Val,":",integer_to_list(N)]|enc_cg_put_bits(T, ",")]; 2464enc_cg_put_bits([], _) -> []. 2465 2466mk_val({var,Str}) -> Str; 2467mk_val({expr,Str}) -> Str; 2468mk_val(Int) when is_integer(Int) -> integer_to_list(Int); 2469mk_val(Other) -> {asis,Other}. 2470 2471%%% 2472%%% Generate a function that maps a name of a bit position 2473%%% to the bit position. 2474%%% 2475 2476bit_string_name2pos_fun(NNL, Src) -> 2477 {call_gen,"bit_string_name2pos_",NNL, 2478 fun(Fd, Name) -> gen_name2pos(Fd, Name, NNL) end,[],[Src]}. 2479 2480gen_name2pos(Fd, Name, Names) -> 2481 Cs0 = gen_name2pos_cs(Names, Name), 2482 Cs = Cs0 ++ [bit_clause(Name),nil_clause(),invalid_clause()], 2483 F0 = {function,1,Name,1,Cs}, 2484 F = erl_parse:new_anno(F0), 2485 file:write(Fd, [erl_pp:function(F)]). 2486 2487gen_name2pos_cs([{K,V}|T], Name) -> 2488 P = [{cons,0,{atom,0,K},{var,0,'T'}}], 2489 B = [{cons,0,{integer,0,V},{call,0,{atom,0,Name},[{var,0,'T'}]}}], 2490 [{clause,0,P,[],B}|gen_name2pos_cs(T, Name)]; 2491gen_name2pos_cs([], _) -> []. 2492 2493bit_clause(Name) -> 2494 VarT = {var,0,'T'}, 2495 VarPos = {var,0,'Pos'}, 2496 P = [{cons,0,{tuple,0,[{atom,0,bit},VarPos]},VarT}], 2497 G = [[{call,0,{atom,0,is_integer},[VarPos]}]], 2498 B = [{cons,0,VarPos,{call,0,{atom,0,Name},[VarT]}}], 2499 {clause,0,P,G,B}. 2500 2501nil_clause() -> 2502 P = B = [{nil,0}], 2503 {clause,0,P,[],B}. 2504 2505invalid_clause() -> 2506 P = [{var,0,'_'}], 2507 B = [{call,0,{atom,0,throw},[{atom,0,invalid}]}], 2508 {clause,0,P,[],B}. 2509 2510%%% 2511%%% Hoist alignment to reduce the number of list elements in 2512%%% encode. Fewer lists elements means faster traversal in 2513%%% complete/{2,3}. 2514%%% 2515%%% For example, the following data sequence: 2516%%% 2517%%% [align,<<1:1,0:1>>,[align,<<Len:16>>|Data]] 2518%%% 2519%%% can be rewritten to: 2520%%% 2521%%% [align,<<1:1,0:1,0:6>>,[<<Len:16>>|Data]] 2522%%% 2523%%% The change from the literal <<1:1,0:1>> to <<1:1,0:1,0:6>> 2524%%% comes for free, and we have eliminated one element of the 2525%%% sub list. 2526%%% 2527%%% We must be careful not to rewrite: 2528%%% 2529%%% [<<1:1,0:1>>,[align,<<Len:16>>|Data]] 2530%%% 2531%%% to: 2532%%% 2533%%% [[<<1:1,0:1>>,align],[<<Len:16>>|Data]] 2534%%% 2535%%% because even though [<<1:0,0:1>>,align] is a literal and does 2536%%% not add any additional construction cost, there is one more 2537%%% sub list that needs to be traversed. 2538%%% 2539 2540enc_hoist_align(Imm0) -> 2541 Imm = enc_hoist_align_reverse(Imm0, []), 2542 enc_hoist_align(Imm, false, []). 2543 2544enc_hoist_align_reverse([H|T], Acc) -> 2545 case enc_opt_al_1([H], 0) of 2546 {[H],_} -> 2547 enc_hoist_align_reverse(T, [H|Acc]); 2548 {_,_} -> 2549 lists:reverse(T, [H,stop|Acc]) 2550 end; 2551enc_hoist_align_reverse([], Acc) -> Acc. 2552 2553enc_hoist_align([stop|T], _Aligned, Acc) -> 2554 lists:reverse(T, Acc); 2555enc_hoist_align([{block,Bl0}|T], Aligned, Acc) -> 2556 Bl = case Aligned of 2557 false -> Bl0; 2558 true -> enc_hoist_block(Bl0) 2559 end, 2560 case is_beginning_aligned(Bl) of 2561 false -> 2562 enc_hoist_align(T, false, [{block,Bl}|Acc]); 2563 true -> 2564 enc_hoist_align(T, true, [{put_bits,0,0,[1,align]}, 2565 {block,Bl}|Acc]) 2566 end; 2567enc_hoist_align([H|T], _, Acc) -> 2568 enc_hoist_align(T, false, [H|Acc]); 2569enc_hoist_align([], _, Acc) -> Acc. 2570 2571enc_hoist_block(Bl) -> 2572 try 2573 enc_hoist_block_1(lists:reverse(Bl)) 2574 catch 2575 throw:impossible -> 2576 Bl 2577 end. 2578 2579enc_hoist_block_1([{'cond',Cs0}|T]) -> 2580 Cs = [[C|enc_hoist_block_2(Act)] || [C|Act] <- Cs0], 2581 H = {'cond',Cs}, 2582 lists:reverse(T, [H]); 2583enc_hoist_block_1(_) -> 2584 throw(impossible). 2585 2586enc_hoist_block_2([{'cond',_}|_]=L) -> 2587 enc_hoist_block(L); 2588enc_hoist_block_2([{error,_}]=L) -> 2589 L; 2590enc_hoist_block_2([]) -> 2591 [{put_bits,0,0,[1,align]}]; 2592enc_hoist_block_2(L) -> 2593 case lists:last(L) of 2594 {put_bits,_,_,_} -> 2595 L ++ [{put_bits,0,0,[1,align]}]; 2596 _ -> 2597 throw(impossible) 2598 end. 2599 2600%%% 2601%%% Optimize alignment for encoding. 2602%%% 2603 2604enc_opt_al(Imm0) -> 2605 {Imm,_} = enc_opt_al_1(Imm0, unknown), 2606 Imm. 2607 2608enc_opt_al_1([H0|T0], Al0) -> 2609 {H,Al1} = enc_opt_al(H0, Al0), 2610 {T,Al} = enc_opt_al_1(T0, Al1), 2611 {H++T,Al}; 2612enc_opt_al_1([], Al) -> {[],Al}. 2613 2614enc_opt_al({assign,_,_}=Imm, Al) -> 2615 {[Imm],Al}; 2616enc_opt_al({block,Bl0}, Al0) -> 2617 {Bl,Al} = enc_opt_al_1(Bl0, Al0), 2618 {[{block,Bl}],Al}; 2619enc_opt_al({call,erlang,iolist_to_binary,[_]}=Imm, Al) -> 2620 {[Imm],Al}; 2621enc_opt_al({call,per_common,encode_fragmented,[_,U]}=Call, Al) -> 2622 case U rem 8 of 2623 0 -> {[Call],Al}; 2624 _ -> {[Call],unknown} 2625 end; 2626enc_opt_al({call,per_common,encode_unconstrained_number,[_]}=Call, _) -> 2627 {[Call],0}; 2628enc_opt_al({call,_,_,_,_}=Call, Al) -> 2629 {[Call],Al}; 2630enc_opt_al({comment,_}=Imm, Al) -> 2631 {[Imm],Al}; 2632enc_opt_al({'cond',Cs0}, Al0) -> 2633 {Cs,Al} = enc_opt_al_cond(Cs0, Al0), 2634 {[{'cond',Cs}],Al}; 2635enc_opt_al({error,_}=Imm, Al) -> 2636 {[Imm],Al}; 2637enc_opt_al({list,Imm0,Dst}, Al) -> 2638 Imm1 = enc_opt_hoist_align(Imm0), 2639 {Imm,_} = enc_opt_al_1(Imm1, 0), 2640 {[{list,Imm,Dst}],Al}; 2641enc_opt_al({put_bits,V,N,[U,align]}, Al0) when Al0 rem 8 =:= 0 -> 2642 Al = if 2643 is_integer(N) -> N*U; 2644 N =:= binary, U rem 8 =:= 0 -> 0; 2645 true -> unknown 2646 end, 2647 {[{put_bits,V,N,[U]}],Al}; 2648enc_opt_al({put_bits,V,binary,[U,align]}, Al0) when is_integer(Al0) -> 2649 N = 8 - (Al0 rem 8), 2650 Al = case U rem 8 of 2651 0 -> 0; 2652 _ -> unknown 2653 end, 2654 {[{put_bits,0,N,[1]},{put_bits,V,binary,[U]}],Al}; 2655enc_opt_al({put_bits,V,N0,[U,align]}, Al0) when is_integer(N0), is_integer(Al0) -> 2656 N = N0 + (8 - Al0 rem 8), 2657 Al = N0*U, 2658 {[{put_bits,V,N,[1]}],Al}; 2659enc_opt_al({put_bits,_,N,[U,align]}=PutBits, _) when is_integer(N) -> 2660 {[PutBits],N*U}; 2661enc_opt_al({put_bits,_,binary,[U,align]}=PutBits, _) when U rem 8 =:= 0 -> 2662 {[PutBits],0}; 2663enc_opt_al({put_bits,_,N,[U]}=PutBits, Al) when is_integer(N), is_integer(Al) -> 2664 {[PutBits],Al+N*U}; 2665enc_opt_al({put_bits,_,binary,[U]}=PutBits, Al) when U rem 8 =:= 0 -> 2666 {[PutBits],Al}; 2667enc_opt_al({set,_,_}=Imm, Al) -> 2668 {[Imm],Al}; 2669enc_opt_al({sub,_,_,_}=Imm, Al) -> 2670 {[Imm],Al}; 2671enc_opt_al({'try',_,_,_,_}=Imm, Al) -> 2672 {[Imm],Al}; 2673enc_opt_al(Imm, _) -> 2674 {[Imm],unknown}. 2675 2676enc_opt_al_cond(Cs0, Al0) -> 2677 enc_opt_al_cond_1(Cs0, Al0, [], []). 2678 2679enc_opt_al_cond_1([['_',{error,_}]=C|Cs], Al, CAcc, AAcc) -> 2680 enc_opt_al_cond_1(Cs, Al, [C|CAcc], AAcc); 2681enc_opt_al_cond_1([[C|Act0]|Cs0], Al0, CAcc, AAcc) -> 2682 {Act,Al1} = enc_opt_al_1(Act0, Al0), 2683 Al = if 2684 Al1 =:= unknown -> Al1; 2685 true -> Al1 rem 8 2686 end, 2687 enc_opt_al_cond_1(Cs0, Al0, [[C|Act]|CAcc], [Al|AAcc]); 2688enc_opt_al_cond_1([], _, CAcc, AAcc) -> 2689 Al = case lists:usort(AAcc) of 2690 [] -> unknown; 2691 [Al0] -> Al0; 2692 [_|_] -> unknown 2693 end, 2694 {lists:reverse(CAcc),Al}. 2695 2696enc_opt_hoist_align([{'cond',Cs0},{put_bits,0,0,[1,align]}]=Imm) -> 2697 try 2698 Cs = [insert_align_last(C) || C <- Cs0], 2699 [{'cond',Cs}] 2700 catch 2701 throw:impossible -> 2702 Imm 2703 end; 2704enc_opt_hoist_align(Imm) -> Imm. 2705 2706insert_align_last([_,{error,_}]=C) -> 2707 C; 2708insert_align_last([H|T]) -> 2709 case lists:last(T) of 2710 {put_bits,_,_,_} -> 2711 [H|T ++ [{put_bits,0,0,[1,align]}]]; 2712 _ -> 2713 throw(impossible) 2714 end. 2715 2716%%% 2717%%% For the aligned PER format, fix up the intermediate format 2718%%% before code generation. Code generation will be somewhat 2719%%% easier if 'align' appear as a separate instruction. 2720%%% 2721 2722per_fixup([{apply,_,_}=H|T]) -> 2723 [H|per_fixup(T)]; 2724per_fixup([{block,Block}|T]) -> 2725 [{block,per_fixup(Block)}|per_fixup(T)]; 2726per_fixup([{'assign',_,_}=H|T]) -> 2727 [H|per_fixup(T)]; 2728per_fixup([{comment,_}=H|T]) -> 2729 [H|per_fixup(T)]; 2730per_fixup([{'cond',Cs0}|T]) -> 2731 Cs = [[C|per_fixup(Act)] || [C|Act] <- Cs0], 2732 [{'cond',Cs}|per_fixup(T)]; 2733per_fixup([{call,_,_,_}=H|T]) -> 2734 [H|per_fixup(T)]; 2735per_fixup([{call,_,_,_,_}=H|T]) -> 2736 [H|per_fixup(T)]; 2737per_fixup([{call_gen,_,_,_,_,_}=H|T]) -> 2738 [H|per_fixup(T)]; 2739per_fixup([{error,_}=H|T]) -> 2740 [H|per_fixup(T)]; 2741per_fixup([{lc,B,V,L}|T]) -> 2742 [{lc,per_fixup(B),V,L}|per_fixup(T)]; 2743per_fixup([{lc,B,V,L,Dst}|T]) -> 2744 [{lc,per_fixup(B),V,L,Dst}|per_fixup(T)]; 2745per_fixup([{list,Imm,Dst}|T]) -> 2746 [{list,per_fixup(Imm),Dst}|per_fixup(T)]; 2747per_fixup([{set,_,_}=H|T]) -> 2748 [H|per_fixup(T)]; 2749per_fixup([{sub,_,_,_}=H|T]) -> 2750 [H|per_fixup(T)]; 2751per_fixup([{'try',Try0,{P,Succ0},Else0,Dst}|T]) -> 2752 Try = per_fixup(Try0), 2753 Succ = per_fixup(Succ0), 2754 Else = per_fixup(Else0), 2755 [{'try',Try,{P,Succ},Else,Dst}|per_fixup(T)]; 2756per_fixup([{put_bits,_,_,_}|_]=L) -> 2757 fixup_put_bits(L); 2758per_fixup([{var,_}=H|T]) -> 2759 [H|per_fixup(T)]; 2760per_fixup([]) -> []. 2761 2762fixup_put_bits([{put_bits,0,0,[_,align]}|T]) -> 2763 [align|fixup_put_bits(T)]; 2764fixup_put_bits([{put_bits,0,0,_}|T]) -> 2765 fixup_put_bits(T); 2766fixup_put_bits([{put_bits,V,N,[U,align]}|T]) -> 2767 [align,{put_bits,V,N,[U]}|fixup_put_bits(T)]; 2768fixup_put_bits([{put_bits,_,_,_}=H|T]) -> 2769 [H|fixup_put_bits(T)]; 2770fixup_put_bits(Other) -> per_fixup(Other). 2771 2772%% effective_constraint(Type,C) 2773%% Type = atom() 2774%% C = [C1,...] 2775%% C1 = {'SingleValue',SV} | {'ValueRange',VR} | {atom(),term()} 2776%% SV = integer() | [integer(),...] 2777%% VR = {Lb,Ub} 2778%% Lb = 'MIN' | integer() 2779%% Ub = 'MAX' | integer() 2780%% Returns a single value if C only has a single value constraint, and no 2781%% value range constraints, that constrains to a single value, otherwise 2782%% returns a value range that has the lower bound set to the lowest value 2783%% of all single values and lower bound values in C and the upper bound to 2784%% the greatest value. 2785effective_constraint(integer, [{{_,_}=Root,_}|_Rest]) -> 2786 %% Normalize extension. Note that any range given for the 2787 %% extension should be ignored anyway. 2788 [{Root,[]}]; 2789effective_constraint(integer, C) -> 2790 SVs = get_constraints(C, 'SingleValue'), 2791 SV = effective_constr('SingleValue', SVs), 2792 VRs = get_constraints(C, 'ValueRange'), 2793 VR = effective_constr('ValueRange', VRs), 2794 greatest_common_range(SV, VR); 2795effective_constraint(bitstring, C) -> 2796 case get_constraint(C, 'SizeConstraint') of 2797 {{Lb,Ub},[]}=Range when is_integer(Lb) -> 2798 if 2799 is_integer(Ub), Ub < 16#10000 -> 2800 Range; 2801 true -> 2802 no 2803 end; 2804 {Lb,Ub}=Range when is_integer(Lb) -> 2805 if 2806 is_integer(Ub), Ub < 16#10000 -> 2807 if 2808 Lb =:= Ub -> Lb; 2809 true -> Range 2810 end; 2811 true -> 2812 no 2813 end; 2814 no -> 2815 no 2816 end. 2817 2818effective_constr(_, []) -> []; 2819effective_constr('SingleValue', List) -> 2820 SVList = lists:flatten(lists:map(fun(X) -> element(2, X) end, List)), 2821 %% Sort and remove duplicates before generating SingleValue or ValueRange 2822 %% In case of ValueRange, also check for 'MIN and 'MAX' 2823 case lists:usort(SVList) of 2824 [N] -> 2825 [{'SingleValue',N}]; 2826 [_|_]=L -> 2827 [{'ValueRange',{least_Lb(L),greatest_Ub(L)}}] 2828 end; 2829effective_constr('ValueRange', List) -> 2830 LBs = lists:map(fun({_,{Lb,_}}) -> Lb end, List), 2831 UBs = lists:map(fun({_,{_,Ub}}) -> Ub end, List), 2832 Lb = least_Lb(LBs), 2833 [{'ValueRange',{Lb,lists:max(UBs)}}]. 2834 2835greatest_common_range([], VR) -> 2836 VR; 2837greatest_common_range(SV, []) -> 2838 SV; 2839greatest_common_range([{_,Int}], [{_,{'MIN',Ub}}]) 2840 when is_integer(Int), Int > Ub -> 2841 [{'ValueRange',{'MIN',Int}}]; 2842greatest_common_range([{_,Int}],[{_,{Lb,Ub}}]) 2843 when is_integer(Int), Int < Lb -> 2844 [{'ValueRange',{Int,Ub}}]; 2845greatest_common_range([{_,Int}],VR=[{_,{_Lb,_Ub}}]) when is_integer(Int) -> 2846 VR; 2847greatest_common_range([{_,L}],[{_,{Lb,Ub}}]) when is_list(L) -> 2848 Min = least_Lb([Lb|L]), 2849 Max = greatest_Ub([Ub|L]), 2850 [{'ValueRange',{Min,Max}}]; 2851greatest_common_range([{_,{Lb1,Ub1}}], [{_,{Lb2,Ub2}}]) -> 2852 Min = least_Lb([Lb1,Lb2]), 2853 Max = greatest_Ub([Ub1,Ub2]), 2854 [{'ValueRange',{Min,Max}}]. 2855 2856 2857least_Lb(L) -> 2858 case lists:member('MIN', L) of 2859 true -> 'MIN'; 2860 false -> lists:min(L) 2861 end. 2862 2863greatest_Ub(L) -> 2864 case lists:member('MAX', L) of 2865 true -> 'MAX'; 2866 false -> lists:max(L) 2867 end. 2868 2869get_constraint(C, Key) -> 2870 case lists:keyfind(Key, 1, C) of 2871 false -> no; 2872 {_,V} -> V 2873 end. 2874 2875get_constraints([{Key,_}=Pair|T], Key) -> 2876 [Pair|get_constraints(T, Key)]; 2877get_constraints([_|T], Key) -> 2878 get_constraints(T, Key); 2879get_constraints([], _) -> []. 2880