1%% ``Licensed under the Apache License, Version 2.0 (the "License"); 2%% you may not use this file except in compliance with the License. 3%% You may obtain a copy of the License at 4%% 5%% http://www.apache.org/licenses/LICENSE-2.0 6%% 7%% Unless required by applicable law or agreed to in writing, software 8%% distributed under the License is distributed on an "AS IS" BASIS, 9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 10%% See the License for the specific language governing permissions and 11%% limitations under the License. 12%% 13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. 14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings 15%% AB. All Rights Reserved.'' 16%% 17%% $Id: asn1ct.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ 18-module(asn1ct). 19 20%% Compile Time functions for ASN.1 (e.g ASN.1 compiler). 21 22%%-compile(export_all). 23%% Public exports 24-export([compile/1, compile/2]). 25-export([start/0, start/1, stop/0]). 26-export([encode/2, encode/3, decode/3]). 27-export([test/1, test/2, test/3, value/2]). 28%% Application internal exports 29-export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3,value/1,vsn/0, 30 create_ets_table/2,get_name_of_def/1,get_pos_of_def/1]). 31-export([read_config_data/1,get_gen_state_field/1,get_gen_state/0, 32 partial_inc_dec_toptype/1,save_gen_state/1,update_gen_state/2, 33 get_tobe_refed_func/1,reset_gen_state/0,is_function_generated/1, 34 generated_refed_func/1,next_refed_func/0,pop_namelist/0, 35 next_namelist_el/0,update_namelist/1,step_in_constructed/0, 36 add_tobe_refed_func/1,add_generated_refed_func/1]). 37 38-include("asn1_records.hrl"). 39-include_lib("stdlib/include/erl_compile.hrl"). 40 41-import(asn1ct_gen_ber_bin_v2,[encode_tag_val/3,decode_class/1]). 42 43-define(unique_names,0). 44-define(dupl_uniquedefs,1). 45-define(dupl_equaldefs,2). 46-define(dupl_eqdefs_uniquedefs,?dupl_equaldefs bor ?dupl_uniquedefs). 47 48-define(CONSTRUCTED, 2#00100000). 49 50%% macros used for partial decode commands 51-define(CHOOSEN,choosen). 52-define(SKIP,skip). 53-define(SKIP_OPTIONAL,skip_optional). 54 55%% macros used for partial incomplete decode commands 56-define(MANDATORY,mandatory). 57-define(DEFAULT,default). 58-define(OPTIONAL,opt). 59-define(PARTS,parts). 60-define(UNDECODED,undec). 61-define(ALTERNATIVE,alt). 62-define(ALTERNATIVE_UNDECODED,alt_undec). 63-define(ALTERNATIVE_PARTS,alt_parts). 64%-define(BINARY,bin). 65 66%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 67%% This is the interface to the compiler 68%% 69%% 70 71 72compile(File) -> 73 compile(File,[]). 74 75compile(File,Options) when list(Options) -> 76 Options1 = 77 case {lists:member(optimize,Options),lists:member(ber_bin,Options)} of 78 {true,true} -> 79 [ber_bin_v2|Options--[ber_bin]]; 80 _ -> Options 81 end, 82 case (catch input_file_type(File)) of 83 {single_file,PrefixedFile} -> 84 (catch compile1(PrefixedFile,Options1)); 85 {multiple_files_file,SetBase,FileName} -> 86 FileList = get_file_list(FileName), 87 (catch compile_set(SetBase,filename:dirname(FileName), 88 FileList,Options1)); 89 Err = {input_file_error,_Reason} -> 90 {error,Err} 91 end. 92 93 94compile1(File,Options) when list(Options) -> 95 io:format("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,File]), 96 io:format("Compiler Options: ~p~n",[Options]), 97 Ext = filename:extension(File), 98 Base = filename:basename(File,Ext), 99 OutFile = outfile(Base,"",Options), 100 DbFile = outfile(Base,"asn1db",Options), 101 Includes = [I || {i,I} <- Options], 102 EncodingRule = get_rule(Options), 103 create_ets_table(asn1_functab,[named_table]), 104 Continue1 = scan({true,true},File,Options), 105 Continue2 = parse(Continue1,File,Options), 106 Continue3 = check(Continue2,File,OutFile,Includes,EncodingRule, 107 DbFile,Options,[]), 108 Continue4 = generate(Continue3,OutFile,EncodingRule,Options), 109 delete_tables([asn1_functab]), 110 compile_erl(Continue4,OutFile,Options). 111 112%%****************************************************************************%% 113%% functions dealing with compiling of several input files to one output file %% 114%%****************************************************************************%% 115compile_set(SetBase,DirName,Files,Options) when list(hd(Files)),list(Options) -> 116 %% case when there are several input files in a list 117 io:format("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,Files]), 118 io:format("Compiler Options: ~p~n",[Options]), 119 OutFile = outfile(SetBase,"",Options), 120 DbFile = outfile(SetBase,"asn1db",Options), 121 Includes = [I || {i,I} <- Options], 122 EncodingRule = get_rule(Options), 123 create_ets_table(asn1_functab,[named_table]), 124 ScanRes = scan_set(DirName,Files,Options), 125 ParseRes = parse_set(ScanRes,Options), 126 Result = 127 case [X||X <- ParseRes,element(1,X)==true] of 128 [] -> %% all were false, time to quit 129 lists:map(fun(X)->element(2,X) end,ParseRes); 130 ParseRes -> %% all were true, continue with check 131 InputModules = 132 lists:map( 133 fun(F)-> 134 E = filename:extension(F), 135 B = filename:basename(F,E), 136 if 137 list(B) -> list_to_atom(B); 138 true -> B 139 end 140 end, 141 Files), 142 check_set(ParseRes,SetBase,OutFile,Includes, 143 EncodingRule,DbFile,Options,InputModules); 144 Other -> 145 {error,{'unexpected error in scan/parse phase', 146 lists:map(fun(X)->element(3,X) end,Other)}} 147 end, 148 delete_tables([asn1_functab]), 149 Result. 150 151check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile, 152 Options,InputModules) -> 153 lists:foreach(fun({_T,M,File})-> 154 cmp(M#module.name,File) 155 end, 156 ParseRes), 157 MergedModule = merge_modules(ParseRes,SetBase), 158 SetM = MergedModule#module{name=SetBase}, 159 Continue1 = check({true,SetM},SetBase,OutFile,Includes,EncRule,DbFile, 160 Options,InputModules), 161 Continue2 = generate(Continue1,OutFile,EncRule,Options), 162 163 delete_tables([renamed_defs,original_imports,automatic_tags]), 164 165 compile_erl(Continue2,OutFile,Options). 166 167%% merge_modules/2 -> returns a module record where the typeorval lists are merged, 168%% the exports lists are merged, the imports lists are merged when the 169%% elements come from other modules than the merge set, the tagdefault 170%% field gets the shared value if all modules have same tagging scheme, 171%% otherwise a tagging_error exception is thrown, 172%% the extensiondefault ...(not handled yet). 173merge_modules(ParseRes,CommonName) -> 174 ModuleList = lists:map(fun(X)->element(2,X) end,ParseRes), 175 NewModuleList = remove_name_collisions(ModuleList), 176 case ets:info(renamed_defs,size) of 177 0 -> ets:delete(renamed_defs); 178 _ -> ok 179 end, 180 save_imports(NewModuleList), 181% io:format("~p~n~p~n~p~n~n",[ets:lookup(original_imports,'M1'),ets:lookup(original_imports,'M2'),ets:tab2list(original_imports)]), 182 TypeOrVal = lists:append(lists:map(fun(X)->X#module.typeorval end, 183 NewModuleList)), 184 InputMNameList = lists:map(fun(X)->X#module.name end, 185 NewModuleList), 186 CExports = common_exports(NewModuleList), 187 188 ImportsModuleNameList = lists:map(fun(X)-> 189 {X#module.imports, 190 X#module.name} end, 191 NewModuleList), 192 %% ImportsModuleNameList: [{Imports,ModuleName},...] 193 %% Imports is a tuple {imports,[#'SymbolsFromModule'{},...]} 194 CImports = common_imports(ImportsModuleNameList,InputMNameList), 195 TagDefault = check_tagdefault(NewModuleList), 196 #module{name=CommonName,tagdefault=TagDefault,exports=CExports, 197 imports=CImports,typeorval=TypeOrVal}. 198 199%% causes an exit if duplicate definition names exist in a module 200remove_name_collisions(Modules) -> 201 create_ets_table(renamed_defs,[named_table]), 202 %% Name duplicates in the same module is not allowed. 203 lists:foreach(fun exit_if_nameduplicate/1,Modules), 204 %% Then remove duplicates in different modules and return the 205 %% new list of modules. 206 remove_name_collisions2(Modules,[]). 207 208%% For each definition in the first module in module list, find 209%% all definitons with same name and rename both definitions in 210%% the first module and in rest of modules 211remove_name_collisions2([M|Ms],Acc) -> 212 TypeOrVal = M#module.typeorval, 213 MName = M#module.name, 214 %% Test each name in TypeOrVal on all modules in Ms 215 {NewM,NewMs} = remove_name_collisions2(MName,TypeOrVal,Ms,[]), 216 remove_name_collisions2(NewMs,[M#module{typeorval=NewM}|Acc]); 217remove_name_collisions2([],Acc) -> 218 finished_warn_prints(), 219 Acc. 220 221%% For each definition in list of defs find definitions in (rest of) 222%% modules that have same name. If duplicate was found rename def. 223%% Test each name in [T|Ts] on all modules in Ms 224remove_name_collisions2(ModName,[T|Ts],Ms,Acc) -> 225 Name = get_name_of_def(T), 226 case discover_dupl_in_mods(Name,T,Ms,[],?unique_names) of 227 {_,?unique_names} -> % there was no name collision 228 remove_name_collisions2(ModName,Ts,Ms,[T|Acc]); 229 {NewMs,?dupl_uniquedefs} -> % renamed defs in NewMs 230 %% rename T 231 NewT = set_name_of_def(ModName,Name,T), %rename def 232 warn_renamed_def(ModName,get_name_of_def(NewT),Name), 233 ets:insert(renamed_defs,{get_name_of_def(NewT),Name,ModName}), 234 remove_name_collisions2(ModName,Ts,NewMs,[NewT|Acc]); 235 {NewMs,?dupl_equaldefs} -> % name duplicates, but identical defs 236 %% keep name of T 237 warn_kept_def(ModName,Name), 238 remove_name_collisions2(ModName,Ts,NewMs,[T|Acc]); 239 {NewMs,?dupl_eqdefs_uniquedefs} -> 240 %% keep name of T, renamed defs in NewMs 241 warn_kept_def(ModName,Name), 242 remove_name_collisions2(ModName,Ts,NewMs,[T|Acc]) 243 end; 244remove_name_collisions2(_,[],Ms,Acc) -> 245 {Acc,Ms}. 246 247%% Name is the name of a definition. If a definition with the same name 248%% is found in the modules Ms the definition will be renamed and returned. 249discover_dupl_in_mods(Name,Def,[M=#module{name=N,typeorval=TorV}|Ms], 250 Acc,AnyRenamed) -> 251 Fun = fun(T,RenamedOrDupl)-> 252 case {get_name_of_def(T),compare_defs(Def,T)} of 253 {Name,not_equal} -> 254 %% rename def 255 NewT=set_name_of_def(N,Name,T), 256 warn_renamed_def(N,get_name_of_def(NewT),Name), 257 ets:insert(renamed_defs,{get_name_of_def(NewT), 258 Name,N}), 259 {NewT,?dupl_uniquedefs bor RenamedOrDupl}; 260 {Name,equal} -> 261 %% delete def 262 warn_deleted_def(N,Name), 263 {[],?dupl_equaldefs bor RenamedOrDupl}; 264 _ -> 265 {T,RenamedOrDupl} 266 end 267 end, 268 {NewTorV,NewAnyRenamed} = lists:mapfoldl(Fun,AnyRenamed,TorV), 269 %% have to flatten the NewTorV to remove any empty list elements 270 discover_dupl_in_mods(Name,Def,Ms, 271 [M#module{typeorval=lists:flatten(NewTorV)}|Acc], 272 NewAnyRenamed); 273discover_dupl_in_mods(_,_,[],Acc,AnyRenamed) -> 274 {Acc,AnyRenamed}. 275 276warn_renamed_def(ModName,NewName,OldName) -> 277 maybe_first_warn_print(), 278 io:format("NOTICE: The ASN.1 definition in module ~p with name ~p has been renamed in generated module. New name is ~p.~n",[ModName,OldName,NewName]). 279 280warn_deleted_def(ModName,DefName) -> 281 maybe_first_warn_print(), 282 io:format("NOTICE: The ASN.1 definition in module ~p with name ~p has been deleted in generated module.~n",[ModName,DefName]). 283 284warn_kept_def(ModName,DefName) -> 285 maybe_first_warn_print(), 286 io:format("NOTICE: The ASN.1 definition in module ~p with name ~p has kept its name due to equal definition as duplicate.~n",[ModName,DefName]). 287 288maybe_first_warn_print() -> 289 case get(warn_duplicate_defs) of 290 undefined -> 291 put(warn_duplicate_defs,true), 292 io:format("~nDue to multiple occurrences of a definition name in " 293 "multi-file compiled files:~n"); 294 _ -> 295 ok 296 end. 297finished_warn_prints() -> 298 put(warn_duplicate_defs,undefined). 299 300 301exit_if_nameduplicate(#module{typeorval=TorV}) -> 302 exit_if_nameduplicate(TorV); 303exit_if_nameduplicate([]) -> 304 ok; 305exit_if_nameduplicate([Def|Rest]) -> 306 Name=get_name_of_def(Def), 307 exit_if_nameduplicate2(Name,Rest), 308 exit_if_nameduplicate(Rest). 309 310exit_if_nameduplicate2(Name,Rest) -> 311 Pred=fun(Def)-> 312 case get_name_of_def(Def) of 313 Name -> true; 314 _ -> false 315 end 316 end, 317 case lists:any(Pred,Rest) of 318 true -> 319 throw({error,{"more than one definition with same name",Name}}); 320 _ -> 321 ok 322 end. 323 324compare_defs(D1,D2) -> 325 compare_defs2(unset_pos(D1),unset_pos(D2)). 326compare_defs2(D,D) -> 327 equal; 328compare_defs2(_,_) -> 329 not_equal. 330 331unset_pos(Def) when record(Def,typedef) -> 332 Def#typedef{pos=undefined}; 333unset_pos(Def) when record(Def,classdef) -> 334 Def#classdef{pos=undefined}; 335unset_pos(Def) when record(Def,valuedef) -> 336 Def#valuedef{pos=undefined}; 337unset_pos(Def) when record(Def,ptypedef) -> 338 Def#ptypedef{pos=undefined}; 339unset_pos(Def) when record(Def,pvaluedef) -> 340 Def#pvaluedef{pos=undefined}; 341unset_pos(Def) when record(Def,pvaluesetdef) -> 342 Def#pvaluesetdef{pos=undefined}; 343unset_pos(Def) when record(Def,pobjectdef) -> 344 Def#pobjectdef{pos=undefined}; 345unset_pos(Def) when record(Def,pobjectsetdef) -> 346 Def#pobjectsetdef{pos=undefined}. 347 348get_pos_of_def(#typedef{pos=Pos}) -> 349 Pos; 350get_pos_of_def(#classdef{pos=Pos}) -> 351 Pos; 352get_pos_of_def(#valuedef{pos=Pos}) -> 353 Pos; 354get_pos_of_def(#ptypedef{pos=Pos}) -> 355 Pos; 356get_pos_of_def(#pvaluedef{pos=Pos}) -> 357 Pos; 358get_pos_of_def(#pvaluesetdef{pos=Pos}) -> 359 Pos; 360get_pos_of_def(#pobjectdef{pos=Pos}) -> 361 Pos; 362get_pos_of_def(#pobjectsetdef{pos=Pos}) -> 363 Pos. 364 365 366get_name_of_def(#typedef{name=Name}) -> 367 Name; 368get_name_of_def(#classdef{name=Name}) -> 369 Name; 370get_name_of_def(#valuedef{name=Name}) -> 371 Name; 372get_name_of_def(#ptypedef{name=Name}) -> 373 Name; 374get_name_of_def(#pvaluedef{name=Name}) -> 375 Name; 376get_name_of_def(#pvaluesetdef{name=Name}) -> 377 Name; 378get_name_of_def(#pobjectdef{name=Name}) -> 379 Name; 380get_name_of_def(#pobjectsetdef{name=Name}) -> 381 Name. 382 383set_name_of_def(ModName,Name,OldDef) -> 384 NewName = list_to_atom(lists:concat([Name,ModName])), 385 case OldDef of 386 #typedef{} -> OldDef#typedef{name=NewName}; 387 #classdef{} -> OldDef#classdef{name=NewName}; 388 #valuedef{} -> OldDef#valuedef{name=NewName}; 389 #ptypedef{} -> OldDef#ptypedef{name=NewName}; 390 #pvaluedef{} -> OldDef#pvaluedef{name=NewName}; 391 #pvaluesetdef{} -> OldDef#pvaluesetdef{name=NewName}; 392 #pobjectdef{} -> OldDef#pobjectdef{name=NewName}; 393 #pobjectsetdef{} -> OldDef#pobjectsetdef{name=NewName} 394 end. 395 396save_imports(ModuleList)-> 397 Fun = fun(M) -> 398 case M#module.imports of 399 {_,[]} -> []; 400 {_,I} -> 401 {M#module.name,I} 402 end 403 end, 404 ImportsList = lists:map(Fun,ModuleList), 405 case lists:flatten(ImportsList) of 406 [] -> 407 ok; 408 ImportsList2 -> 409 create_ets_table(original_imports,[named_table]), 410 ets:insert(original_imports,ImportsList2) 411 end. 412 413 414common_exports(ModuleList) -> 415 %% if all modules exports 'all' then export 'all', 416 %% otherwise export each typeorval name 417 case lists:filter(fun(X)-> 418 element(2,X#module.exports) /= all 419 end, 420 ModuleList) of 421 []-> 422 {exports,all}; 423 ModsWithExpList -> 424 CExports1 = 425 lists:append(lists:map(fun(X)->element(2,X#module.exports) end, 426 ModsWithExpList)), 427 CExports2 = export_all(lists:subtract(ModuleList,ModsWithExpList)), 428 {exports,CExports1++CExports2} 429 end. 430 431export_all([])->[]; 432export_all(ModuleList) -> 433 ExpList = 434 lists:map( 435 fun(M)-> 436 TorVL=M#module.typeorval, 437 MName = M#module.name, 438 lists:map( 439 fun(Def)-> 440 case Def of 441 T when record(T,typedef)-> 442 #'Externaltypereference'{pos=0, 443 module=MName, 444 type=T#typedef.name}; 445 V when record(V,valuedef) -> 446 #'Externalvaluereference'{pos=0, 447 module=MName, 448 value=V#valuedef.name}; 449 C when record(C,classdef) -> 450 #'Externaltypereference'{pos=0, 451 module=MName, 452 type=C#classdef.name}; 453 P when record(P,ptypedef) -> 454 #'Externaltypereference'{pos=0, 455 module=MName, 456 type=P#ptypedef.name}; 457 PV when record(PV,pvaluesetdef) -> 458 #'Externaltypereference'{pos=0, 459 module=MName, 460 type=PV#pvaluesetdef.name}; 461 PO when record(PO,pobjectdef) -> 462 #'Externalvaluereference'{pos=0, 463 module=MName, 464 value=PO#pobjectdef.name} 465 end 466 end, 467 TorVL) 468 end, 469 ModuleList), 470 lists:append(ExpList). 471 472%% common_imports/2 473%% IList is a list of tuples, {Imports,MName}, where Imports is the imports of 474%% the module with name MName. 475%% InputMNameL holds the names of all merged modules. 476%% Returns an import tuple with a list of imports that are external the merged 477%% set of modules. 478common_imports(IList,InputMNameL) -> 479 SetExternalImportsList = remove_in_set_imports(IList,InputMNameL,[]), 480 {imports,remove_import_doubles(SetExternalImportsList)}. 481 482check_tagdefault(ModList) -> 483 case have_same_tagdefault(ModList) of 484 {true,TagDefault} -> TagDefault; 485 {false,TagDefault} -> 486 create_ets_table(automatic_tags,[named_table]), 487 save_automatic_tagged_types(ModList), 488 TagDefault 489 end. 490 491have_same_tagdefault([#module{tagdefault=T}|Ms]) -> 492 have_same_tagdefault(Ms,{true,T}). 493 494have_same_tagdefault([],TagDefault) -> 495 TagDefault; 496have_same_tagdefault([#module{tagdefault=T}|Ms],TDefault={_,T}) -> 497 have_same_tagdefault(Ms,TDefault); 498have_same_tagdefault([#module{tagdefault=T1}|Ms],{_,T2}) -> 499 have_same_tagdefault(Ms,{false,rank_tagdef([T1,T2])}). 500 501rank_tagdef(L) -> 502 case lists:member('EXPLICIT',L) of 503 true -> 'EXPLICIT'; 504 _ -> 'IMPLICIT' 505 end. 506 507save_automatic_tagged_types([])-> 508 done; 509save_automatic_tagged_types([#module{tagdefault='AUTOMATIC', 510 typeorval=TorV}|Ms]) -> 511 Fun = 512 fun(T) -> 513 ets:insert(automatic_tags,{get_name_of_def(T)}) 514 end, 515 lists:foreach(Fun,TorV), 516 save_automatic_tagged_types(Ms); 517save_automatic_tagged_types([_M|Ms]) -> 518 save_automatic_tagged_types(Ms). 519 520%% remove_in_set_imports/3 : 521%% input: list with tuples of each module's imports and module name 522%% respectively. 523%% output: one list with same format but each occurred import from a 524%% module in the input set (IMNameL) is removed. 525remove_in_set_imports([{{imports,ImpL},_ModName}|Rest],InputMNameL,Acc) -> 526 NewImpL = remove_in_set_imports1(ImpL,InputMNameL,[]), 527 remove_in_set_imports(Rest,InputMNameL,NewImpL++Acc); 528remove_in_set_imports([],_,Acc) -> 529 lists:reverse(Acc). 530 531remove_in_set_imports1([I|Is],InputMNameL,Acc) -> 532 case I#'SymbolsFromModule'.module of 533 #'Externaltypereference'{type=MName} -> 534 case lists:member(MName,InputMNameL) of 535 true -> 536 remove_in_set_imports1(Is,InputMNameL,Acc); 537 false -> 538 remove_in_set_imports1(Is,InputMNameL,[I|Acc]) 539 end; 540 _ -> 541 remove_in_set_imports1(Is,InputMNameL,[I|Acc]) 542 end; 543remove_in_set_imports1([],_,Acc) -> 544 lists:reverse(Acc). 545 546remove_import_doubles([]) -> 547 []; 548%% If several modules in the merge set imports symbols from 549%% the same external module it might be doubled. 550%% ImportList has #'SymbolsFromModule' elements 551remove_import_doubles(ImportList) -> 552 MergedImportList = 553 merge_symbols_from_module(ImportList,[]), 554%% io:format("MergedImportList: ~p~n",[MergedImportList]), 555 delete_double_of_symbol(MergedImportList,[]). 556 557merge_symbols_from_module([Imp|Imps],Acc) -> 558 #'Externaltypereference'{type=ModName} = Imp#'SymbolsFromModule'.module, 559 IfromModName = 560 lists:filter( 561 fun(I)-> 562 case I#'SymbolsFromModule'.module of 563 #'Externaltypereference'{type=ModName} -> 564 true; 565 #'Externalvaluereference'{value=ModName} -> 566 true; 567 _ -> false 568 end 569 end, 570 Imps), 571 NewImps = lists:subtract(Imps,IfromModName), 572%% io:format("Imp: ~p~nIfromModName: ~p~n",[Imp,IfromModName]), 573 NewImp = 574 Imp#'SymbolsFromModule'{ 575 symbols = lists:append( 576 lists:map(fun(SL)-> 577 SL#'SymbolsFromModule'.symbols 578 end,[Imp|IfromModName]))}, 579 merge_symbols_from_module(NewImps,[NewImp|Acc]); 580merge_symbols_from_module([],Acc) -> 581 lists:reverse(Acc). 582 583delete_double_of_symbol([I|Is],Acc) -> 584 SymL=I#'SymbolsFromModule'.symbols, 585 NewSymL = delete_double_of_symbol1(SymL,[]), 586 delete_double_of_symbol(Is,[I#'SymbolsFromModule'{symbols=NewSymL}|Acc]); 587delete_double_of_symbol([],Acc) -> 588 Acc. 589 590delete_double_of_symbol1([TRef=#'Externaltypereference'{type=TrefName}|Rest],Acc)-> 591 NewRest = 592 lists:filter(fun(S)-> 593 case S of 594 #'Externaltypereference'{type=TrefName}-> 595 false; 596 _ -> true 597 end 598 end, 599 Rest), 600 delete_double_of_symbol1(NewRest,[TRef|Acc]); 601delete_double_of_symbol1([VRef=#'Externalvaluereference'{value=VName}|Rest],Acc) -> 602 NewRest = 603 lists:filter(fun(S)-> 604 case S of 605 #'Externalvaluereference'{value=VName}-> 606 false; 607 _ -> true 608 end 609 end, 610 Rest), 611 delete_double_of_symbol1(NewRest,[VRef|Acc]); 612delete_double_of_symbol1([TRef={#'Externaltypereference'{type=MRef}, 613 #'Externaltypereference'{type=TRef}}|Rest], 614 Acc)-> 615 NewRest = 616 lists:filter( 617 fun(S)-> 618 case S of 619 {#'Externaltypereference'{type=MRef}, 620 #'Externaltypereference'{type=TRef}}-> 621 false; 622 _ -> true 623 end 624 end, 625 Rest), 626 delete_double_of_symbol1(NewRest,[TRef|Acc]); 627delete_double_of_symbol1([],Acc) -> 628 Acc. 629 630 631scan_set(DirName,Files,Options) -> 632 lists:map( 633 fun(F)-> 634 case scan({true,true},filename:join([DirName,F]),Options) of 635 {false,{error,Reason}} -> 636 throw({error,{'scan error in file:',F,Reason}}); 637 {TrueOrFalse,Res} -> 638 {TrueOrFalse,Res,F} 639 end 640 end, 641 Files). 642 643parse_set(ScanRes,Options) -> 644 lists:map( 645 fun({TorF,Toks,F})-> 646 case parse({TorF,Toks},F,Options) of 647 {false,{error,Reason}} -> 648 throw({error,{'parse error in file:',F,Reason}}); 649 {TrueOrFalse,Res} -> 650 {TrueOrFalse,Res,F} 651 end 652 end, 653 ScanRes). 654 655 656%%*********************************** 657 658 659scan({true,_}, File,Options) -> 660 case asn1ct_tok:file(File) of 661 {error,Reason} -> 662 io:format("~p~n",[Reason]), 663 {false,{error,Reason}}; 664 Tokens -> 665 case lists:member(ss,Options) of 666 true -> % we terminate after scan 667 {false,Tokens}; 668 false -> % continue with next pass 669 {true,Tokens} 670 end 671 end; 672scan({false,Result},_,_) -> 673 Result. 674 675 676parse({true,Tokens},File,Options) -> 677 %Presult = asn1ct_parser2:parse(Tokens), 678 %%case lists:member(p1,Options) of 679 %% true -> 680 %% asn1ct_parser:parse(Tokens); 681 %% _ -> 682 %% asn1ct_parser2:parse(Tokens) 683 %% end, 684 case catch asn1ct_parser2:parse(Tokens) of 685 {error,{{Line,_Mod,Message},_TokTup}} -> 686 if 687 integer(Line) -> 688 BaseName = filename:basename(File), 689 io:format("syntax error at line ~p in module ~s:~n", 690 [Line,BaseName]); 691 true -> 692 io:format("syntax error in module ~p:~n",[File]) 693 end, 694 print_error_message(Message), 695 {false,{error,Message}}; 696 {error,{Line,_Mod,[Message,Token]}} -> 697 io:format("syntax error: ~p ~p at line ~p~n", 698 [Message,Token,Line]), 699 {false,{error,{Line,[Message,Token]}}}; 700 {ok,M} -> 701 case lists:member(sp,Options) of 702 true -> % terminate after parse 703 {false,M}; 704 false -> % continue with next pass 705 {true,M} 706 end; 707 OtherError -> 708 io:format("~p~n",[OtherError]) 709 end; 710parse({false,Tokens},_,_) -> 711 {false,Tokens}. 712 713check({true,M},File,OutFile,Includes,EncodingRule,DbFile,Options,InputMods) -> 714 cmp(M#module.name,File), 715 start(["."|Includes]), 716 case asn1ct_check:storeindb(M) of 717 ok -> 718 Module = asn1_db:dbget(M#module.name,'MODULE'), 719 State = #state{mname=Module#module.name, 720 module=Module#module{typeorval=[]}, 721 erule=EncodingRule, 722 inputmodules=InputMods, 723 options=Options}, 724 Check = asn1ct_check:check(State,Module#module.typeorval), 725 case {Check,lists:member(abs,Options)} of 726 {{error,Reason},_} -> 727 {false,{error,Reason}}; 728 {{ok,NewTypeOrVal,_},true} -> 729 NewM = Module#module{typeorval=NewTypeOrVal}, 730 asn1_db:dbput(NewM#module.name,'MODULE',NewM), 731 pretty2(M#module.name,lists:concat([OutFile,".abs"])), 732 {false,ok}; 733 {{ok,NewTypeOrVal,GenTypeOrVal},_} -> 734 NewM = Module#module{typeorval=NewTypeOrVal}, 735 asn1_db:dbput(NewM#module.name,'MODULE',NewM), 736 asn1_db:dbsave(DbFile,M#module.name), 737 io:format("--~p--~n",[{generated,DbFile}]), 738 {true,{M,NewM,GenTypeOrVal}} 739 end 740 end; 741check({false,M},_,_,_,_,_,_,_) -> 742 {false,M}. 743 744generate({true,{M,_Module,GenTOrV}},OutFile,EncodingRule,Options) -> 745 debug_on(Options), 746 case lists:member(compact_bit_string,Options) of 747 true -> put(compact_bit_string,true); 748 _ -> ok 749 end, 750 put(encoding_options,Options), 751 create_ets_table(check_functions,[named_table]), 752 753 %% create decoding function names and taglists for partial decode 754 %% For the time being leave errors unnoticed !!!!!!!!! 755% io:format("Options: ~p~n",[Options]), 756 case catch specialized_decode_prepare(EncodingRule,M,GenTOrV,Options) of 757 {error, enoent} -> ok; 758 {error, Reason} -> io:format("WARNING: Error in configuration" 759 "file: ~n~p~n",[Reason]); 760 {'EXIT',Reason} -> io:format("WARNING: Internal error when " 761 "analyzing configuration" 762 "file: ~n~p~n",[Reason]); 763 _ -> ok 764 end, 765 766 asn1ct_gen:pgen(OutFile,EncodingRule,M#module.name,GenTOrV), 767 debug_off(Options), 768 put(compact_bit_string,false), 769 erase(encoding_options), 770 erase(tlv_format), % used in ber_bin, optimize 771 erase(class_default_type),% used in ber_bin, optimize 772 ets:delete(check_functions), 773 case lists:member(sg,Options) of 774 true -> % terminate here , with .erl file generated 775 {false,true}; 776 false -> 777 {true,true} 778 end; 779generate({false,M},_,_,_) -> 780 {false,M}. 781 782compile_erl({true,_},OutFile,Options) -> 783 erl_compile(OutFile,Options); 784compile_erl({false,true},_,_) -> 785 ok; 786compile_erl({false,Result},_,_) -> 787 Result. 788 789input_file_type([]) -> 790 {empty_name,[]}; 791input_file_type(File) -> 792 case filename:extension(File) of 793 [] -> 794 case file:read_file_info(lists:concat([File,".asn1"])) of 795 {ok,_FileInfo} -> 796 {single_file, lists:concat([File,".asn1"])}; 797 _Error -> 798 case file:read_file_info(lists:concat([File,".asn"])) of 799 {ok,_FileInfo} -> 800 {single_file, lists:concat([File,".asn"])}; 801 _Error -> 802 {single_file, lists:concat([File,".py"])} 803 end 804 end; 805 ".asn1config" -> 806 case read_config_file(File,asn1_module) of 807 {ok,Asn1Module} -> 808 put(asn1_config_file,File), 809 input_file_type(Asn1Module); 810 Error -> 811 Error 812 end; 813 Asn1PFix -> 814 Base = filename:basename(File,Asn1PFix), 815 case filename:extension(Base) of 816 [] -> 817 {single_file,File}; 818 SetPFix when (SetPFix == ".set") -> 819 {multiple_files_file, 820 filename:basename(Base,SetPFix), 821 File}; 822 _Error -> 823 throw({input_file_error,{'Bad input file',File}}) 824 end 825 end. 826 827get_file_list(File) -> 828 case file:open(File, [read]) of 829 {error,Reason} -> 830 {error,{File,file:format_error(Reason)}}; 831 {ok,Stream} -> 832 get_file_list1(Stream,[]) 833 end. 834 835get_file_list1(Stream,Acc) -> 836 Ret = io:get_line(Stream,''), 837 case Ret of 838 eof -> 839 file:close(Stream), 840 lists:reverse(Acc); 841 FileName -> 842 PrefixedNameList = 843 case (catch input_file_type(lists:delete($\n,FileName))) of 844 {empty_name,[]} -> []; 845 {single_file,Name} -> [Name]; 846 {multiple_files_file,Name} -> 847 get_file_list(Name); 848 Err = {input_file_error,_Reason} -> 849 throw(Err) 850 end, 851 get_file_list1(Stream,PrefixedNameList++Acc) 852 end. 853 854get_rule(Options) -> 855 case [Rule ||Rule <-[per,ber,ber_bin,ber_bin_v2,per_bin], 856 Opt <- Options, 857 Rule==Opt] of 858 [Rule] -> 859 Rule; 860 [Rule|_] -> 861 Rule; 862 [] -> 863 ber 864 end. 865 866erl_compile(OutFile,Options) -> 867% io:format("Options:~n~p~n",[Options]), 868 case lists:member(noobj,Options) of 869 true -> 870 ok; 871 _ -> 872 ErlOptions = remove_asn_flags(Options), 873 case c:c(OutFile,ErlOptions) of 874 {ok,_Module} -> 875 ok; 876 _ -> 877 {error,'no_compilation'} 878 end 879 end. 880 881remove_asn_flags(Options) -> 882 [X || X <- Options, 883 X /= get_rule(Options), 884 X /= optimize, 885 X /= compact_bit_string, 886 X /= debug, 887 X /= keyed_list]. 888 889debug_on(Options) -> 890 case lists:member(debug,Options) of 891 true -> 892 put(asndebug,true); 893 _ -> 894 true 895 end, 896 case lists:member(keyed_list,Options) of 897 true -> 898 put(asn_keyed_list,true); 899 _ -> 900 true 901 end. 902 903 904debug_off(_Options) -> 905 erase(asndebug), 906 erase(asn_keyed_list). 907 908 909outfile(Base, Ext, Opts) when atom(Ext) -> 910 outfile(Base, atom_to_list(Ext), Opts); 911outfile(Base, Ext, Opts) -> 912 Obase = case lists:keysearch(outdir, 1, Opts) of 913 {value, {outdir, Odir}} -> filename:join(Odir, Base); 914 _NotFound -> Base % Not found or bad format 915 end, 916 case Ext of 917 [] -> 918 Obase; 919 _ -> 920 Obase++"."++Ext 921 end. 922 923%% compile(AbsFileName, Options) 924%% Compile entry point for erl_compile. 925 926compile_asn(File,OutFile,Options) -> 927 compile(lists:concat([File,".asn"]),OutFile,Options). 928 929compile_asn1(File,OutFile,Options) -> 930 compile(lists:concat([File,".asn1"]),OutFile,Options). 931 932compile_py(File,OutFile,Options) -> 933 compile(lists:concat([File,".py"]),OutFile,Options). 934 935compile(File, _OutFile, Options) -> 936 case catch compile(File, make_erl_options(Options)) of 937 Exit = {'EXIT',_Reason} -> 938 io:format("~p~n~s~n",[Exit,"error"]), 939 error; 940 {error,_Reason} -> 941 %% case occurs due to error in asn1ct_parser2,asn1ct_check 942%% io:format("~p~n",[_Reason]), 943%% io:format("~p~n~s~n",[_Reason,"error"]), 944 error; 945 ok -> 946 io:format("ok~n"), 947 ok; 948 ParseRes when tuple(ParseRes) -> 949 io:format("~p~n",[ParseRes]), 950 ok; 951 ScanRes when list(ScanRes) -> 952 io:format("~p~n",[ScanRes]), 953 ok; 954 Unknown -> 955 io:format("~p~n~s~n",[Unknown,"error"]), 956 error 957 end. 958 959%% Converts generic compiler options to specific options. 960 961make_erl_options(Opts) -> 962 963 %% This way of extracting will work even if the record passed 964 %% has more fields than known during compilation. 965 966 Includes = Opts#options.includes, 967 Defines = Opts#options.defines, 968 Outdir = Opts#options.outdir, 969%% Warning = Opts#options.warning, 970 Verbose = Opts#options.verbose, 971 Specific = Opts#options.specific, 972 Optimize = Opts#options.optimize, 973 OutputType = Opts#options.output_type, 974 Cwd = Opts#options.cwd, 975 976 Options = 977 case Verbose of 978 true -> [verbose]; 979 false -> [] 980 end ++ 981%%% case Warning of 982%%% 0 -> []; 983%%% _ -> [report_warnings] 984%%% end ++ 985 [] ++ 986 case Optimize of 987 1 -> [optimize]; 988 999 -> []; 989 _ -> [{optimize,Optimize}] 990 end ++ 991 lists:map( 992 fun ({Name, Value}) -> 993 {d, Name, Value}; 994 (Name) -> 995 {d, Name} 996 end, 997 Defines) ++ 998 case OutputType of 999 undefined -> [ber]; % temporary default (ber when it's ready) 1000 ber -> [ber]; 1001 ber_bin -> [ber_bin]; 1002 ber_bin_v2 -> [ber_bin_v2]; 1003 per -> [per]; 1004 per_bin -> [per_bin] 1005 end, 1006 1007 Options++[report_errors, {cwd, Cwd}, {outdir, Outdir}| 1008 lists:map(fun(Dir) -> {i, Dir} end, Includes)]++Specific. 1009 1010pretty2(Module,AbsFile) -> 1011 start(), 1012 {ok,F} = file:open(AbsFile, [write]), 1013 M = asn1_db:dbget(Module,'MODULE'), 1014 io:format(F,"%%%%%%%%%%%%%%%%%%% ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), 1015 io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.defid)]), 1016 io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.tagdefault)]), 1017 io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.exports)]), 1018 io:format(F,"~s\n",[asn1ct_pretty_format:term(M#module.imports)]), 1019 io:format(F,"~s\n\n",[asn1ct_pretty_format:term(M#module.extensiondefault)]), 1020 1021 {Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets} = M#module.typeorval, 1022 io:format(F,"%%%%%%%%%%%%%%%%%%% TYPES in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), 1023 lists:foreach(fun(T)-> io:format(F,"~s\n", 1024 [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) 1025 end,Types), 1026 io:format(F,"%%%%%%%%%%%%%%%%%%% VALUES in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), 1027 lists:foreach(fun(T)-> io:format(F,"~s\n", 1028 [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) 1029 end,Values), 1030 io:format(F,"%%%%%%%%%%%%%%%%%%% Parameterized Types in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), 1031 lists:foreach(fun(T)-> io:format(F,"~s\n", 1032 [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) 1033 end,ParameterizedTypes), 1034 io:format(F,"%%%%%%%%%%%%%%%%%%% Classes in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), 1035 lists:foreach(fun(T)-> io:format(F,"~s\n", 1036 [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) 1037 end,Classes), 1038 io:format(F,"%%%%%%%%%%%%%%%%%%% Objects in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), 1039 lists:foreach(fun(T)-> io:format(F,"~s\n", 1040 [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) 1041 end,Objects), 1042 io:format(F,"%%%%%%%%%%%%%%%%%%% Object Sets in ~p %%%%%%%%%%%%%%%%%%%~n",[Module]), 1043 lists:foreach(fun(T)-> io:format(F,"~s\n", 1044 [asn1ct_pretty_format:term(asn1_db:dbget(Module,T))]) 1045 end,ObjectSets). 1046start() -> 1047 Includes = ["."], 1048 start(Includes). 1049 1050 1051start(Includes) when list(Includes) -> 1052 asn1_db:dbstart(Includes). 1053 1054stop() -> 1055 save(), 1056 asn1_db:stop_server(ns), 1057 asn1_db:stop_server(rand), 1058 stopped. 1059 1060save() -> 1061 asn1_db:dbstop(). 1062 1063%%clear() -> 1064%% asn1_db:dbclear(). 1065 1066encode(Module,Term) -> 1067 asn1rt:encode(Module,Term). 1068 1069encode(Module,Type,Term) when list(Module) -> 1070 asn1rt:encode(list_to_atom(Module),Type,Term); 1071encode(Module,Type,Term) -> 1072 asn1rt:encode(Module,Type,Term). 1073 1074decode(Module,Type,Bytes) when list(Module) -> 1075 asn1rt:decode(list_to_atom(Module),Type,Bytes); 1076decode(Module,Type,Bytes) -> 1077 asn1rt:decode(Module,Type,Bytes). 1078 1079 1080test(Module) -> 1081 start(), 1082 M = asn1_db:dbget(Module,'MODULE'), 1083 {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets} = M#module.typeorval, 1084 test_each(Module,Types). 1085 1086test_each(Module,[Type | Rest]) -> 1087 case test(Module,Type) of 1088 {ok,_Result} -> 1089 test_each(Module,Rest); 1090 Error -> 1091 Error 1092 end; 1093test_each(_,[]) -> 1094 ok. 1095 1096test(Module,Type) -> 1097 io:format("~p:~p~n",[Module,Type]), 1098 case (catch value(Module,Type)) of 1099 {ok,Val} -> 1100 %% io:format("asn1ct:test/2: ~w~n",[Val]), 1101 test(Module,Type,Val); 1102 {'EXIT',Reason} -> 1103 {error,{asn1,{value,Reason}}} 1104 end. 1105 1106 1107test(Module,Type,Value) -> 1108 case catch encode(Module,Type,Value) of 1109 {ok,Bytes} -> 1110 %% io:format("test 1: ~p~n",[{Bytes}]), 1111 M = if 1112 list(Module) -> 1113 list_to_atom(Module); 1114 true -> 1115 Module 1116 end, 1117 NewBytes = 1118 case M:encoding_rule() of 1119 ber -> 1120 lists:flatten(Bytes); 1121 ber_bin when binary(Bytes) -> 1122 Bytes; 1123 ber_bin -> 1124 list_to_binary(Bytes); 1125 ber_bin_v2 when binary(Bytes) -> 1126 Bytes; 1127 ber_bin_v2 -> 1128 list_to_binary(Bytes); 1129 per -> 1130 lists:flatten(Bytes); 1131 per_bin when binary(Bytes) -> 1132 Bytes; 1133 per_bin -> 1134 list_to_binary(Bytes) 1135 end, 1136 case decode(Module,Type,NewBytes) of 1137 {ok,Value} -> 1138 {ok,{Module,Type,Value}}; 1139 {ok,Res} -> 1140 {error,{asn1,{encode_decode_mismatch, 1141 {{Module,Type,Value},Res}}}}; 1142 Error -> 1143 {error,{asn1,{{decode, 1144 {Module,Type,Value},Error}}}} 1145 end; 1146 Error -> 1147 {error,{asn1,{encode,{{Module,Type,Value},Error}}}} 1148 end. 1149 1150value(Module) -> 1151 start(), 1152 M = asn1_db:dbget(Module,'MODULE'), 1153 {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets} = M#module.typeorval, 1154 lists:map(fun(A) ->value(Module,A) end,Types). 1155 1156value(Module,Type) -> 1157 start(), 1158 case catch asn1ct_value:get_type(Module,Type,no) of 1159 {error,Reason} -> 1160 {error,Reason}; 1161 {'EXIT',Reason} -> 1162 {error,Reason}; 1163 Result -> 1164 {ok,Result} 1165 end. 1166 1167cmp(Module,InFile) -> 1168 Base = filename:basename(InFile), 1169 Dir = filename:dirname(InFile), 1170 Ext = filename:extension(Base), 1171 Finfo = file:read_file_info(InFile), 1172 Minfo = file:read_file_info(filename:join(Dir,lists:concat([Module,Ext]))), 1173 case Finfo of 1174 Minfo -> 1175 ok; 1176 _ -> 1177 io:format("asn1error: Modulename and filename must be equal~n",[]), 1178 throw(error) 1179 end. 1180 1181vsn() -> 1182 ?vsn. 1183 1184print_error_message([got,H|T]) when list(H) -> 1185 io:format(" got:"), 1186 print_listing(H,"and"), 1187 print_error_message(T); 1188print_error_message([expected,H|T]) when list(H) -> 1189 io:format(" expected one of:"), 1190 print_listing(H,"or"), 1191 print_error_message(T); 1192print_error_message([H|T]) -> 1193 io:format(" ~p",[H]), 1194 print_error_message(T); 1195print_error_message([]) -> 1196 io:format("~n"). 1197 1198print_listing([H1,H2|[]],AndOr) -> 1199 io:format(" ~p ~s ~p",[H1,AndOr,H2]); 1200print_listing([H1,H2|T],AndOr) -> 1201 io:format(" ~p,",[H1]), 1202 print_listing([H2|T],AndOr); 1203print_listing([H],_AndOr) -> 1204 io:format(" ~p",[H]); 1205print_listing([],_) -> 1206 ok. 1207 1208 1209%% functions to administer ets tables 1210 1211%% Always creates a new table 1212create_ets_table(Name,Options) when atom(Name) -> 1213 case ets:info(Name) of 1214 undefined -> 1215 ets:new(Name,Options); 1216 _ -> 1217 ets:delete(Name), 1218 ets:new(Name,Options) 1219 end. 1220 1221%% Creates a new ets table only if no table exists 1222create_if_no_table(Name,Options) -> 1223 case ets:info(Name) of 1224 undefined -> 1225 %% create a new table 1226 create_ets_table(Name,Options); 1227 _ -> ok 1228 end. 1229 1230 1231delete_tables([Table|Ts]) -> 1232 case ets:info(Table) of 1233 undefined -> ok; 1234 _ -> ets:delete(Table) 1235 end, 1236 delete_tables(Ts); 1237delete_tables([]) -> 1238 ok. 1239 1240 1241specialized_decode_prepare(Erule,M,TsAndVs,Options) -> 1242% Asn1confMember = 1243% fun([{asn1config,File}|_],_) -> 1244% {true,File}; 1245% ([],_) -> false; 1246% ([_H|T],Fun) -> 1247% Fun(T,Fun) 1248% end, 1249% case Asn1confMember(Options,Asn1confMember) of 1250% {true,File} -> 1251 case lists:member(asn1config,Options) of 1252 true -> 1253 partial_decode_prepare(Erule,M,TsAndVs,Options); 1254 _ -> 1255 ok 1256 end. 1257%% Reads the configuration file if it exists and stores information 1258%% about partial decode and incomplete decode 1259partial_decode_prepare(ber_bin_v2,M,TsAndVs,Options) when tuple(TsAndVs) -> 1260 %% read configure file 1261% Types = element(1,TsAndVs), 1262 CfgList = read_config_file(M#module.name), 1263 SelectedDecode = get_config_info(CfgList,partial_decode), 1264 ExclusiveDecode = get_config_info(CfgList,exclusive_decode), 1265 CommandList = 1266 create_partial_decode_gen_info(M#module.name,SelectedDecode), 1267% io:format("partial_decode = ~p~n",[CommandList]), 1268 1269 save_config(partial_decode,CommandList), 1270 CommandList2 = 1271 create_partial_inc_decode_gen_info(M#module.name,ExclusiveDecode), 1272% io:format("partial_incomplete_decode = ~p~n",[CommandList2]), 1273 Part_inc_tlv_tags = tag_format(ber_bin_v2,Options,CommandList2), 1274% io:format("partial_incomplete_decode: tlv_tags = ~p~n",[Part_inc_tlv_tags]), 1275 save_config(partial_incomplete_decode,Part_inc_tlv_tags), 1276 save_gen_state(ExclusiveDecode,Part_inc_tlv_tags); 1277partial_decode_prepare(_,_,_,_) -> 1278 ok. 1279 1280 1281 1282%% create_partial_inc_decode_gen_info/2 1283%% 1284%% Creats a list of tags out of the information in TypeNameList that 1285%% tells which value will be incomplete decoded, i.e. each end 1286%% component/type in TypeNameList. The significant types/components in 1287%% the path from the toptype must be specified in the 1288%% TypeNameList. Significant elements are all constructed types that 1289%% branches the path to the leaf and the leaf it selfs. 1290%% 1291%% Returns a list of elements, where an element may be one of 1292%% mandatory|[opt,Tag]|[bin,Tag]. mandatory correspond to a mandatory 1293%% element that shall be decoded as usual. [opt,Tag] matches an 1294%% OPTIONAL or DEFAULT element that shall be decoded as 1295%% usual. [bin,Tag] corresponds to an element, mandatory, OPTIONAL or 1296%% DEFAULT, that shall be left encoded (incomplete decoded). 1297create_partial_inc_decode_gen_info(ModName,{Mod,[{Name,L}|Ls]}) when list(L) -> 1298 TopTypeName = partial_inc_dec_toptype(L), 1299 [{Name,TopTypeName, 1300 create_partial_inc_decode_gen_info1(ModName,TopTypeName,{Mod,L})}| 1301 create_partial_inc_decode_gen_info(ModName,{Mod,Ls})]; 1302create_partial_inc_decode_gen_info(_,{_,[]}) -> 1303 []; 1304create_partial_inc_decode_gen_info(_,[]) -> 1305 []. 1306 1307create_partial_inc_decode_gen_info1(ModName,TopTypeName,{ModName, 1308 [_TopType|Rest]}) -> 1309 case asn1_db:dbget(ModName,TopTypeName) of 1310 #typedef{typespec=TS} -> 1311 TagCommand = get_tag_command(TS,?MANDATORY,mandatory), 1312 create_pdec_inc_command(ModName,get_components(TS#type.def), 1313 Rest,[TagCommand]); 1314 _ -> 1315 throw({error,{"wrong type list in asn1 config file", 1316 TopTypeName}}) 1317 end; 1318create_partial_inc_decode_gen_info1(M1,_,{M2,_}) when M1 /= M2 -> 1319 throw({error,{"wrong module name in asn1 config file", 1320 M2}}); 1321create_partial_inc_decode_gen_info1(_,_,TNL) -> 1322 throw({error,{"wrong type list in asn1 config file", 1323 TNL}}). 1324 1325%% 1326%% Only when there is a 'ComponentType' the config data C1 may be a 1327%% list, where the incomplete decode is branched. So, C1 may be a 1328%% list, a "binary tuple", a "parts tuple" or an atom. The second 1329%% element of a binary tuple and a parts tuple is an atom. 1330create_pdec_inc_command(_ModName,_,[],Acc) -> 1331 lists:reverse(Acc); 1332create_pdec_inc_command(ModName,{Comps1,Comps2},TNL,Acc) 1333 when list(Comps1),list(Comps2) -> 1334 create_pdec_inc_command(ModName,Comps1 ++ Comps2,TNL,Acc); 1335create_pdec_inc_command(ModN,Clist,[CL|_Rest],Acc) when list(CL) -> 1336 create_pdec_inc_command(ModN,Clist,CL,Acc); 1337create_pdec_inc_command(ModName, 1338 CList=[#'ComponentType'{name=Name,typespec=TS, 1339 prop=Prop}|Comps], 1340 TNL=[C1|Cs],Acc) -> 1341 case C1 of 1342% Name -> 1343% %% In this case C1 is an atom 1344% TagCommand = get_tag_command(TS,?MANDATORY,Prop), 1345% create_pdec_inc_command(ModName,get_components(TS#type.def),Cs,[TagCommand|Acc]); 1346 {Name,undecoded} -> 1347 TagCommand = get_tag_command(TS,?UNDECODED,Prop), 1348 create_pdec_inc_command(ModName,Comps,Cs,[TagCommand|Acc]); 1349 {Name,parts} -> 1350 TagCommand = get_tag_command(TS,?PARTS,Prop), 1351 create_pdec_inc_command(ModName,Comps,Cs,[TagCommand|Acc]); 1352 L when list(L) -> 1353 %% This case is only possible as the first element after 1354 %% the top type element, when top type is SEGUENCE or SET. 1355 %% Follow each element in L. Must note every tag on the 1356 %% way until the last command is reached, but it ought to 1357 %% be enough to have a "complete" or "complete optional" 1358 %% command for each component that is not specified in the 1359 %% config file. Then in the TLV decode the components with 1360 %% a "complete" command will be decoded by an ordinary TLV 1361 %% decode. 1362 create_pdec_inc_command(ModName,CList,L,Acc); 1363 {Name,RestPartsList} when list(RestPartsList) -> 1364 %% Same as previous, but this may occur at any place in 1365 %% the structure. The previous is only possible as the 1366 %% second element. 1367 case get_tag_command(TS,?MANDATORY,Prop) of 1368 ?MANDATORY -> 1369 InnerDirectives= 1370 create_pdec_inc_command(ModName,TS#type.def, 1371 RestPartsList,[]), 1372 create_pdec_inc_command(ModName,Comps,Cs, 1373 [[?MANDATORY,InnerDirectives]|Acc]); 1374% create_pdec_inc_command(ModName,Comps,Cs, 1375% [InnerDirectives,?MANDATORY|Acc]); 1376 [Opt,EncTag] -> 1377 InnerDirectives = 1378 create_pdec_inc_command(ModName,TS#type.def, 1379 RestPartsList,[]), 1380 create_pdec_inc_command(ModName,Comps,Cs, 1381 [[Opt,EncTag,InnerDirectives]|Acc]) 1382 end; 1383% create_pdec_inc_command(ModName,CList,RestPartsList,Acc); 1384%% create_pdec_inc_command(ModName,TS#type.def,RestPartsList,Acc); 1385 _ -> %% this component may not be in the config list 1386 TagCommand = get_tag_command(TS,?MANDATORY,Prop), 1387 create_pdec_inc_command(ModName,Comps,TNL,[TagCommand|Acc]) 1388 end; 1389create_pdec_inc_command(ModName, 1390 {'CHOICE',[#'ComponentType'{name=C1, 1391 typespec=TS, 1392 prop=Prop}|Comps]}, 1393 [{C1,Directive}|Rest],Acc) -> 1394 case Directive of 1395 List when list(List) -> 1396 [Command,Tag] = get_tag_command(TS,?ALTERNATIVE,Prop), 1397 CompAcc = create_pdec_inc_command(ModName,TS#type.def,List,[]), 1398 create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, 1399 [[Command,Tag,CompAcc]|Acc]); 1400 undecoded -> 1401 TagCommand = get_tag_command(TS,?ALTERNATIVE_UNDECODED,Prop), 1402 create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, 1403 [TagCommand|Acc]); 1404 parts -> 1405 TagCommand = get_tag_command(TS,?ALTERNATIVE_PARTS,Prop), 1406 create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, 1407 [TagCommand|Acc]) 1408 end; 1409create_pdec_inc_command(ModName, 1410 {'CHOICE',[#'ComponentType'{typespec=TS, 1411 prop=Prop}|Comps]}, 1412 TNL,Acc) -> 1413 TagCommand = get_tag_command(TS,?ALTERNATIVE,Prop), 1414 create_pdec_inc_command(ModName,{'CHOICE',Comps},TNL,[TagCommand|Acc]); 1415create_pdec_inc_command(M,{'CHOICE',{Cs1,Cs2}},TNL,Acc) 1416 when list(Cs1),list(Cs2) -> 1417 create_pdec_inc_command(M,{'CHOICE',Cs1 ++ Cs2},TNL,Acc); 1418create_pdec_inc_command(ModName,#'Externaltypereference'{module=M,type=Name}, 1419 TNL,Acc) -> 1420 #type{def=Def} = get_referenced_type(M,Name), 1421 create_pdec_inc_command(ModName,get_components(Def),TNL,Acc); 1422create_pdec_inc_command(_,_,TNL,_) -> 1423 throw({error,{"unexpected error when creating partial " 1424 "decode command",TNL}}). 1425 1426partial_inc_dec_toptype([T|_]) when atom(T) -> 1427 T; 1428partial_inc_dec_toptype([{T,_}|_]) when atom(T) -> 1429 T; 1430partial_inc_dec_toptype([L|_]) when list(L) -> 1431 partial_inc_dec_toptype(L); 1432partial_inc_dec_toptype(_) -> 1433 throw({error,{"no top type found for partial incomplete decode"}}). 1434 1435 1436%% Creats a list of tags out of the information in TypeList and Types 1437%% that tells which value will be decoded. Each constructed type that 1438%% is in the TypeList will get a "choosen" command. Only the last 1439%% type/component in the TypeList may be a primitive type. Components 1440%% "on the way" to the final element may get the "skip" or the 1441%% "skip_optional" command. 1442%% CommandList = [Elements] 1443%% Elements = {choosen,Tag}|{skip_optional,Tag}|skip 1444%% Tag is a binary with the tag BER encoded. 1445create_partial_decode_gen_info(ModName,{{_,ModName},TypeList}) -> 1446 case TypeList of 1447 [TopType|Rest] -> 1448 case asn1_db:dbget(ModName,TopType) of 1449 #typedef{typespec=TS} -> 1450 TagCommand = get_tag_command(TS,?CHOOSEN), 1451 create_pdec_command(ModName,get_components(TS#type.def), 1452 Rest,[TagCommand]); 1453 _ -> 1454 throw({error,{"wrong type list in asn1 config file", 1455 TypeList}}) 1456 end; 1457 _ -> 1458 [] 1459 end; 1460create_partial_decode_gen_info(_,[]) -> 1461 []; 1462create_partial_decode_gen_info(_M1,{{_,M2},_}) -> 1463 throw({error,{"wrong module name in asn1 config file", 1464 M2}}). 1465 1466%% create_pdec_command/4 for each name (type or component) in the 1467%% third argument, TypeNameList, a command is created. The command has 1468%% information whether the component/type shall be skipped, looked 1469%% into or returned. The list of commands is returned. 1470create_pdec_command(_ModName,_,[],Acc) -> 1471 lists:reverse(Acc); 1472create_pdec_command(ModName,[#'ComponentType'{name=C1,typespec=TS}|_Comps], 1473 [C1|Cs],Acc) -> 1474 %% this component is a constructed type or the last in the 1475 %% TypeNameList otherwise the config spec is wrong 1476 TagCommand = get_tag_command(TS,?CHOOSEN), 1477 create_pdec_command(ModName,get_components(TS#type.def), 1478 Cs,[TagCommand|Acc]); 1479create_pdec_command(ModName,[#'ComponentType'{typespec=TS, 1480 prop=Prop}|Comps], 1481 [C2|Cs],Acc) -> 1482 TagCommand = 1483 case Prop of 1484 mandatory -> 1485 get_tag_command(TS,?SKIP); 1486 _ -> 1487 get_tag_command(TS,?SKIP_OPTIONAL) 1488 end, 1489 create_pdec_command(ModName,Comps,[C2|Cs],[TagCommand|Acc]); 1490create_pdec_command(ModName,{'CHOICE',[Comp=#'ComponentType'{name=C1}|_]},TNL=[C1|_Cs],Acc) -> 1491 create_pdec_command(ModName,[Comp],TNL,Acc); 1492create_pdec_command(ModName,{'CHOICE',[#'ComponentType'{}|Comps]},TNL,Acc) -> 1493 create_pdec_command(ModName,{'CHOICE',Comps},TNL,Acc); 1494create_pdec_command(ModName,#'Externaltypereference'{module=M,type=C1}, 1495 TypeNameList,Acc) -> 1496 case get_referenced_type(M,C1) of 1497 #type{def=Def} -> 1498 create_pdec_command(ModName,get_components(Def),TypeNameList, 1499 Acc); 1500 Err -> 1501 throw({error,{"unexpected result when fetching " 1502 "referenced element",Err}}) 1503 end; 1504create_pdec_command(ModName,TS=#type{def=Def},[C1|Cs],Acc) -> 1505 %% This case when we got the "components" of a SEQUENCE/SET OF 1506 case C1 of 1507 [1] -> 1508 %% A list with an integer is the only valid option in a 'S 1509 %% OF', the other valid option would be an empty 1510 %% TypeNameList saying that the entire 'S OF' will be 1511 %% decoded. 1512 TagCommand = get_tag_command(TS,?CHOOSEN), 1513 create_pdec_command(ModName,Def,Cs,[TagCommand|Acc]); 1514 [N] when integer(N) -> 1515 TagCommand = get_tag_command(TS,?SKIP), 1516 create_pdec_command(ModName,Def,[[N-1]|Cs],[TagCommand|Acc]); 1517 Err -> 1518 throw({error,{"unexpected error when creating partial " 1519 "decode command",Err}}) 1520 end; 1521create_pdec_command(_,_,TNL,_) -> 1522 throw({error,{"unexpected error when creating partial " 1523 "decode command",TNL}}). 1524 1525% get_components({'CHOICE',Components}) -> 1526% Components; 1527get_components(#'SEQUENCE'{components=Components}) -> 1528 Components; 1529get_components(#'SET'{components=Components}) -> 1530 Components; 1531get_components({'SEQUENCE OF',Components}) -> 1532 Components; 1533get_components({'SET OF',Components}) -> 1534 Components; 1535get_components(Def) -> 1536 Def. 1537 1538%% get_tag_command(Type,Command) 1539 1540%% Type is the type that has information about the tag Command tells 1541%% what to do with the encoded value with the tag of Type when 1542%% decoding. 1543get_tag_command(#type{tag=[]},_) -> 1544 []; 1545get_tag_command(#type{tag=[_Tag]},?SKIP) -> 1546 ?SKIP; 1547get_tag_command(#type{tag=[Tag]},Command) -> 1548 %% encode the tag according to BER 1549 [Command,encode_tag_val(decode_class(Tag#tag.class),Tag#tag.form, 1550 Tag#tag.number)]; 1551get_tag_command(T=#type{tag=[Tag|Tags]},Command) -> 1552 [get_tag_command(T#type{tag=Tag},Command)| 1553 get_tag_command(T#type{tag=Tags},Command)]. 1554 1555%% get_tag_command/3 used by create_pdec_inc_command 1556get_tag_command(#type{tag=[]},_,_) -> 1557 []; 1558get_tag_command(#type{tag=[Tag]},?MANDATORY,Prop) -> 1559 case Prop of 1560 mandatory -> 1561 ?MANDATORY; 1562 {'DEFAULT',_} -> 1563 [?DEFAULT,encode_tag_val(decode_class(Tag#tag.class), 1564 Tag#tag.form,Tag#tag.number)]; 1565 _ -> [?OPTIONAL,encode_tag_val(decode_class(Tag#tag.class), 1566 Tag#tag.form,Tag#tag.number)] 1567 end; 1568get_tag_command(#type{tag=[Tag]},Command,_) -> 1569 [Command,encode_tag_val(decode_class(Tag#tag.class),Tag#tag.form, 1570 Tag#tag.number)]. 1571 1572 1573get_referenced_type(M,Name) -> 1574 case asn1_db:dbget(M,Name) of 1575 #typedef{typespec=TS} -> 1576 case TS of 1577 #type{def=#'Externaltypereference'{module=M2,type=Name2}} -> 1578 %% The tags have already been taken care of in the 1579 %% first reference where they were gathered in a 1580 %% list of tags. 1581 get_referenced_type(M2,Name2); 1582 #type{} -> TS; 1583 _ -> 1584 throw({error,{"unexpected element when" 1585 " fetching referenced type",TS}}) 1586 end; 1587 T -> 1588 throw({error,{"unexpected element when fetching " 1589 "referenced type",T}}) 1590 end. 1591 1592tag_format(EncRule,_Options,CommandList) -> 1593 case EncRule of 1594 ber_bin_v2 -> 1595 tlv_tags(CommandList); 1596 _ -> 1597 CommandList 1598 end. 1599 1600tlv_tags([]) -> 1601 []; 1602tlv_tags([mandatory|Rest]) -> 1603 [mandatory|tlv_tags(Rest)]; 1604tlv_tags([[Command,Tag]|Rest]) when atom(Command),binary(Tag) -> 1605 [[Command,tlv_tag(Tag)]|tlv_tags(Rest)]; 1606tlv_tags([[Command,Directives]|Rest]) when atom(Command),list(Directives) -> 1607 [[Command,tlv_tags(Directives)]|tlv_tags(Rest)]; 1608%% remove all empty lists 1609tlv_tags([[]|Rest]) -> 1610 tlv_tags(Rest); 1611tlv_tags([{Name,TopType,L1}|Rest]) when list(L1),atom(TopType) -> 1612 [{Name,TopType,tlv_tags(L1)}|tlv_tags(Rest)]; 1613tlv_tags([[Command,Tag,L1]|Rest]) when list(L1),binary(Tag) -> 1614 [[Command,tlv_tag(Tag),tlv_tags(L1)]|tlv_tags(Rest)]; 1615tlv_tags([L=[L1|_]|Rest]) when list(L1) -> 1616 [tlv_tags(L)|tlv_tags(Rest)]. 1617 1618tlv_tag(<<Cl:2,_:1,TagNo:5>>) when TagNo < 31 -> 1619 (Cl bsl 16) + TagNo; 1620tlv_tag(<<Cl:2,_:1,31:5,0:1,TagNo:7>>) -> 1621 (Cl bsl 16) + TagNo; 1622tlv_tag(<<Cl:2,_:1,31:5,Buffer/binary>>) -> 1623 TagNo = tlv_tag1(Buffer,0), 1624 (Cl bsl 16) + TagNo. 1625tlv_tag1(<<0:1,PartialTag:7>>,Acc) -> 1626 (Acc bsl 7) bor PartialTag; 1627tlv_tag1(<<1:1,PartialTag:7,Buffer/binary>>,Acc) -> 1628 tlv_tag1(Buffer,(Acc bsl 7) bor PartialTag). 1629 1630%% reads the content from the configuration file and returns the 1631%% selected part chosen by InfoType. Assumes that the config file 1632%% content is an Erlang term. 1633read_config_file(ModuleName,InfoType) when atom(InfoType) -> 1634 CfgList = read_config_file(ModuleName), 1635 get_config_info(CfgList,InfoType). 1636 1637 1638read_config_file(ModuleName) -> 1639 case file:consult(lists:concat([ModuleName,'.asn1config'])) of 1640% case file:consult(ModuleName) of 1641 {ok,CfgList} -> 1642 CfgList; 1643 {error,enoent} -> 1644 Options = get(encoding_options), 1645 Includes = [I || {i,I} <- Options], 1646 read_config_file1(ModuleName,Includes); 1647 {error,Reason} -> 1648 file:format_error(Reason), 1649 throw({error,{"error reading asn1 config file",Reason}}) 1650 end. 1651read_config_file1(ModuleName,[]) -> 1652 case filename:extension(ModuleName) of 1653 ".asn1config" -> 1654 throw({error,enoent}); 1655 _ -> 1656 read_config_file(lists:concat([ModuleName,".asn1config"])) 1657 end; 1658read_config_file1(ModuleName,[H|T]) -> 1659% File = filename:join([H,lists:concat([ModuleName,'.asn1config'])]), 1660 File = filename:join([H,ModuleName]), 1661 case file:consult(File) of 1662 {ok,CfgList} -> 1663 CfgList; 1664 {error,enoent} -> 1665 read_config_file1(ModuleName,T); 1666 {error,Reason} -> 1667 file:format_error(Reason), 1668 throw({error,{"error reading asn1 config file",Reason}}) 1669 end. 1670 1671get_config_info(CfgList,InfoType) -> 1672 case InfoType of 1673 all -> 1674 CfgList; 1675 _ -> 1676 case lists:keysearch(InfoType,1,CfgList) of 1677 {value,{InfoType,Value}} -> 1678 Value; 1679 false -> 1680 [] 1681 end 1682 end. 1683 1684%% save_config/2 saves the Info with the key Key 1685%% Before saving anything check if a table exists 1686save_config(Key,Info) -> 1687 create_if_no_table(asn1_general,[named_table]), 1688 ets:insert(asn1_general,{{asn1_config,Key},Info}). 1689 1690read_config_data(Key) -> 1691 case ets:info(asn1_general) of 1692 undefined -> undefined; 1693 _ -> 1694 case ets:lookup(asn1_general,{asn1_config,Key}) of 1695 [{_,Data}] -> Data; 1696 Err -> 1697 io:format("strange data from config file ~w~n",[Err]), 1698 Err 1699 end 1700 end. 1701 1702 1703%% 1704%% Functions to manipulate the gen_state record saved in the 1705%% asn1_general ets table. 1706%% 1707 1708%% saves input data in a new gen_state record 1709save_gen_state({_,ConfList},PartIncTlvTagList) -> 1710 %ConfList=[{FunctionName,PatternList}|Rest] 1711 StateRec = #gen_state{inc_tag_pattern=PartIncTlvTagList, 1712 inc_type_pattern=ConfList}, 1713 save_config(gen_state,StateRec); 1714save_gen_state(_,_) -> 1715%% ok. 1716 save_config(gen_state,#gen_state{}). 1717 1718save_gen_state(GenState) when record(GenState,gen_state) -> 1719 save_config(gen_state,GenState). 1720 1721 1722%% get_gen_state_field returns undefined if no gen_state exists or if 1723%% Field is undefined or the data at the field. 1724get_gen_state_field(Field) -> 1725 case read_config_data(gen_state) of 1726 undefined -> 1727 undefined; 1728 GenState -> 1729 get_gen_state_field(GenState,Field) 1730 end. 1731get_gen_state_field(#gen_state{active=Active},active) -> 1732 Active; 1733get_gen_state_field(_,active) -> 1734 false; 1735get_gen_state_field(GS,prefix) -> 1736 GS#gen_state.prefix; 1737get_gen_state_field(GS,inc_tag_pattern) -> 1738 GS#gen_state.inc_tag_pattern; 1739get_gen_state_field(GS,tag_pattern) -> 1740 GS#gen_state.tag_pattern; 1741get_gen_state_field(GS,inc_type_pattern) -> 1742 GS#gen_state.inc_type_pattern; 1743get_gen_state_field(GS,type_pattern) -> 1744 GS#gen_state.type_pattern; 1745get_gen_state_field(GS,func_name) -> 1746 GS#gen_state.func_name; 1747get_gen_state_field(GS,namelist) -> 1748 GS#gen_state.namelist; 1749get_gen_state_field(GS,tobe_refed_funcs) -> 1750 GS#gen_state.tobe_refed_funcs; 1751get_gen_state_field(GS,gen_refed_funcs) -> 1752 GS#gen_state.gen_refed_funcs. 1753 1754 1755get_gen_state() -> 1756 read_config_data(gen_state). 1757 1758 1759update_gen_state(Field,Data) -> 1760 case get_gen_state() of 1761 State when record(State,gen_state) -> 1762 update_gen_state(Field,State,Data); 1763 _ -> 1764 exit({error,{asn1,{internal, 1765 "tried to update nonexistent gen_state",Field,Data}}}) 1766 end. 1767update_gen_state(active,State,Data) -> 1768 save_gen_state(State#gen_state{active=Data}); 1769update_gen_state(prefix,State,Data) -> 1770 save_gen_state(State#gen_state{prefix=Data}); 1771update_gen_state(inc_tag_pattern,State,Data) -> 1772 save_gen_state(State#gen_state{inc_tag_pattern=Data}); 1773update_gen_state(tag_pattern,State,Data) -> 1774 save_gen_state(State#gen_state{tag_pattern=Data}); 1775update_gen_state(inc_type_pattern,State,Data) -> 1776 save_gen_state(State#gen_state{inc_type_pattern=Data}); 1777update_gen_state(type_pattern,State,Data) -> 1778 save_gen_state(State#gen_state{type_pattern=Data}); 1779update_gen_state(func_name,State,Data) -> 1780 save_gen_state(State#gen_state{func_name=Data}); 1781update_gen_state(namelist,State,Data) -> 1782% SData = 1783% case Data of 1784% [D] when list(D) -> D; 1785% _ -> Data 1786% end, 1787 save_gen_state(State#gen_state{namelist=Data}); 1788update_gen_state(tobe_refed_funcs,State,Data) -> 1789 save_gen_state(State#gen_state{tobe_refed_funcs=Data}); 1790update_gen_state(gen_refed_funcs,State,Data) -> 1791 save_gen_state(State#gen_state{gen_refed_funcs=Data}). 1792 1793update_namelist(Name) -> 1794 case get_gen_state_field(namelist) of 1795 [Name,Rest] -> update_gen_state(namelist,Rest); 1796 [Name|Rest] -> update_gen_state(namelist,Rest); 1797 [{Name,List}] when list(List) -> update_gen_state(namelist,List); 1798 [{Name,Atom}|Rest] when atom(Atom) -> update_gen_state(namelist,Rest); 1799 Other -> Other 1800 end. 1801 1802pop_namelist() -> 1803 DeepTail = %% removes next element in order 1804 fun([[{_,A}]|T],_Fun) when atom(A) -> T; 1805 ([{_N,L}|T],_Fun) when list(L) -> [L|T]; 1806 ([[]|T],Fun) -> Fun(T,Fun); 1807 ([L1|L2],Fun) when list(L1) -> 1808 case lists:flatten(L1) of 1809 [] -> Fun([L2],Fun); 1810 _ -> [Fun(L1,Fun)|L2] 1811 end; 1812 ([_H|T],_Fun) -> T 1813 end, 1814 {Pop,NewNL} = 1815 case get_gen_state_field(namelist) of 1816 [] -> {[],[]}; 1817 L -> 1818 {next_namelist_el(L), 1819 DeepTail(L,DeepTail)} 1820 end, 1821 update_gen_state(namelist,NewNL), 1822 Pop. 1823 1824%% next_namelist_el fetches the next type/component name in turn in 1825%% the namelist, without changing the namelist. 1826next_namelist_el() -> 1827 case get_gen_state_field(namelist) of 1828 undefined -> undefined; 1829 L when list(L) -> next_namelist_el(L) 1830 end. 1831 1832next_namelist_el([]) -> 1833 []; 1834next_namelist_el([L]) when list(L) -> 1835 next_namelist_el(L); 1836next_namelist_el([H|_]) when atom(H) -> 1837 H; 1838next_namelist_el([L|T]) when list(L) -> 1839 case next_namelist_el(L) of 1840 [] -> 1841 next_namelist_el([T]); 1842 R -> 1843 R 1844 end; 1845next_namelist_el([H={_,A}|_]) when atom(A) -> 1846 H. 1847 1848%% removes a bracket from the namelist 1849step_in_constructed() -> 1850 case get_gen_state_field(namelist) of 1851 [L] when list(L) -> 1852 update_gen_state(namelist,L); 1853 _ -> ok 1854 end. 1855 1856is_function_generated(Name) -> 1857 case get_gen_state_field(gen_refed_funcs) of 1858 L when list(L) -> 1859 lists:member(Name,L); 1860 _ -> 1861 false 1862 end. 1863 1864get_tobe_refed_func(Name) -> 1865 case get_gen_state_field(tobe_refed_funcs) of 1866 L when list(L) -> 1867 case lists:keysearch(Name,1,L) of 1868 {_,Element} -> 1869 Element; 1870 _ -> 1871 undefined 1872 end; 1873 _ -> 1874 undefined 1875 end. 1876 1877add_tobe_refed_func(Data) -> 1878 L = get_gen_state_field(tobe_refed_funcs), 1879 update_gen_state(tobe_refed_funcs,[Data|L]). 1880 1881%% moves Name from the to be list to the generated list. 1882generated_refed_func(Name) -> 1883 L = get_gen_state_field(tobe_refed_funcs), 1884 NewL = lists:keydelete(Name,1,L), 1885 update_gen_state(tobe_refed_funcs,NewL), 1886 L2 = get_gen_state_field(gen_refed_funcs), 1887 update_gen_state(gen_refed_funcs,[Name|L2]). 1888 1889add_generated_refed_func(Data) -> 1890 L = get_gen_state_field(gen_refed_funcs), 1891 update_gen_state(gen_refed_funcs,[Data|L]). 1892 1893 1894next_refed_func() -> 1895 case get_gen_state_field(tobe_refed_funcs) of 1896 [] -> 1897 []; 1898 [H|T] -> 1899 update_gen_state(tobe_refed_funcs,T), 1900 H 1901 end. 1902 1903reset_gen_state() -> 1904 save_gen_state(#gen_state{}). 1905