diff options
Diffstat (limited to 'lib/asn1/src/asn1ct_gen_per.erl')
| -rw-r--r-- | lib/asn1/src/asn1ct_gen_per.erl | 921 |
1 files changed, 82 insertions, 839 deletions
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 69d9d51bf1..8b999ddbf0 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -26,7 +26,7 @@ %-compile(export_all). -export([gen_dec_imm/2]). --export([gen_dec_prim/3,gen_encode_prim/3]). +-export([gen_dec_prim/3,gen_encode_prim_imm/3]). -export([gen_obj_code/3,gen_objectset_code/2]). -export([gen_decode/2, gen_decode/3]). -export([gen_encode/2, gen_encode/3]). @@ -102,832 +102,106 @@ gen_encode_prim(Erules, D) -> Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), gen_encode_prim(Erules, D, Value). -gen_encode_prim(Erules, #type{def={'ENUMERATED',{N1,N2}}}, Value) -> - NewList = [{0,X} || {X,_} <- N1] ++ ['EXT_MARK'] ++ - [{1,X} || {X,_} <- N2], - NewC = {0,length(N1)-1}, - emit(["case ",Value," of",nl]), - emit_enc_enumerated_cases(Erules, NewC, NewList, 0); -gen_encode_prim(Erules, #type{def={'ENUMERATED',NNL}}, Value) -> - NewList = [X || {X,_} <- NNL], - NewC = {0,length(NewList)-1}, - emit(["case ",Value," of",nl]), - emit_enc_enumerated_cases(Erules, NewC, NewList, 0); -gen_encode_prim(per=Erules, D, Value) -> - asn1ct_gen_per_rt2ct:gen_encode_prim(Erules, D, Value); gen_encode_prim(Erules, #type{}=D, Value) -> - Constraint = D#type.constraint, - SizeConstr = asn1ct_imm:effective_constraint(bitstring, Constraint), - Pa = case lists:keyfind('PermittedAlphabet', 1, Constraint) of - false -> no; - {_,Pa0} -> Pa0 - end, - case D#type.def of + Aligned = case Erules of + uper -> false; + per -> true + end, + Imm = gen_encode_prim_imm(Value, D, Aligned), + asn1ct_imm:enc_cg(Imm, Aligned). + +gen_encode_prim_imm(Val, #type{def=Type0,constraint=Constraint}, Aligned) -> + case simplify_type(Type0) of + k_m_string -> + Type = case Type0 of + 'GeneralizedTime' -> 'VisibleString'; + 'UTCTime' -> 'VisibleString'; + _ -> Type0 + end, + asn1ct_imm:per_enc_k_m_string(Val, Type, Constraint, Aligned); + restricted_string -> + ToBinary = {erlang,iolist_to_binary}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); + {'ENUMERATED',NNL} -> + asn1ct_imm:per_enc_enumerated(Val, NNL, Aligned); 'INTEGER' -> - Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - Value], - call(Erules, encode_integer, Args); - {'INTEGER',NamedNumberList} -> - Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, - Value,{asis,NamedNumberList}], - call(Erules, encode_integer, Args); + asn1ct_imm:per_enc_integer(Val, Constraint, Aligned); + {'INTEGER',NNL} -> + asn1ct_imm:per_enc_integer(Val, NNL, Constraint, Aligned); 'REAL' -> - emit_enc_real(Erules, Value); - - {'BIT STRING',NamedNumberList} -> - call(Erules, encode_bit_string, - [{asis,SizeConstr},Value, - {asis,NamedNumberList}]); + ToBinary = {real_common,encode_real}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); + {'BIT STRING',NNL} -> + asn1ct_imm:per_enc_bit_string(Val, NNL, Constraint, Aligned); 'NULL' -> - emit("[]"); + asn1ct_imm:per_enc_null(Val, Aligned); 'OBJECT IDENTIFIER' -> - call(Erules, encode_object_identifier, [Value]); + ToBinary = {per_common,encode_oid}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); 'RELATIVE-OID' -> - call(Erules, encode_relative_oid, [Value]); - 'ObjectDescriptor' -> - call(Erules, encode_ObjectDescriptor, - [{asis,Constraint},Value]); + ToBinary = {per_common,encode_relative_oid}, + asn1ct_imm:per_enc_restricted_string(Val, ToBinary, Aligned); 'BOOLEAN' -> - call(Erules, encode_boolean, [Value]); + asn1ct_imm:per_enc_boolean(Val, Aligned); 'OCTET STRING' -> - case SizeConstr of - 0 -> - emit("[]"); - no -> - call(Erules, encode_octet_string, [Value]); - C -> - call(Erules, encode_octet_string, [{asis,C},Value]) - end; - 'NumericString' -> - call(Erules, encode_NumericString, [{asis,SizeConstr}, - {asis,Pa},Value]); - TString when TString == 'TeletexString'; - TString == 'T61String' -> - call(Erules, encode_TeletexString, [{asis,Constraint},Value]); - 'VideotexString' -> - call(Erules, encode_VideotexString, [{asis,Constraint},Value]); - 'UTCTime' -> - call(Erules, encode_VisibleString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'GeneralizedTime' -> - call(Erules, encode_VisibleString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'GraphicString' -> - call(Erules, encode_GraphicString, [{asis,Constraint},Value]); - 'VisibleString' -> - call(Erules, encode_VisibleString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'GeneralString' -> - call(Erules, encode_GeneralString, [{asis,Constraint},Value]); - 'PrintableString' -> - call(Erules, encode_PrintableString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'IA5String' -> - call(Erules, encode_IA5String, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'BMPString' -> - call(Erules, encode_BMPString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'UniversalString' -> - call(Erules, encode_UniversalString, [{asis,SizeConstr}, - {asis,Pa},Value]); - 'UTF8String' -> - call(Erules, encode_UTF8String, [Value]); + asn1ct_imm:per_enc_octet_string(Val, Constraint, Aligned); 'ASN1_OPEN_TYPE' -> - NewValue = case Constraint of - [#'Externaltypereference'{type=Tname}] -> - asn1ct_func:need({Erules,complete,1}), - io_lib:format( - "complete(enc_~s(~s))",[Tname,Value]); - [#type{def=#'Externaltypereference'{type=Tname}}] -> - asn1ct_func:need({Erules,complete,1}), - io_lib:format( - "complete(enc_~s(~s))", - [Tname,Value]); - _ -> - io_lib:format("iolist_to_binary(~s)", - [Value]) - end, - call(Erules, encode_open_type, [NewValue]) - end. - -emit_enc_real(Erules, Real) -> - asn1ct_name:new(tmpval), - asn1ct_name:new(tmplen), - emit(["begin",nl, - "{",{curr,tmpval},com,{curr,tmplen},"} = ", - {call,real_common,encode_real,[Real]},com,nl, - "[",{call,Erules,encode_length,[{curr,tmplen}]},",", - {curr,tmpval},"]",nl, - "end"]). - -emit_enc_enumerated_cases(Erules, C, ['EXT_MARK'|T], _Count) -> - %% Reset enumeration counter. - emit_enc_enumerated_cases(Erules, C, T, 0); -emit_enc_enumerated_cases(Erules, C, [H|T], Count) -> - emit_enc_enumerated_case(Erules, C, H, Count), - emit([";",nl]), - emit_enc_enumerated_cases(Erules, C, T, Count+1); -emit_enc_enumerated_cases(_Erules, _, [], _Count) -> - emit(["EnumVal -> " - "exit({error,{asn1,{enumerated_not_in_range, EnumVal}}})",nl, - "end"]). - -emit_enc_enumerated_case(Erules, C, {0,EnumName}, Count) -> - %% ENUMERATED with extensionmark; the value lies within then extension root - Enc = enc_ext_and_val(Erules, 0, encode_constrained_number, [C,Count]), - emit(["'",EnumName,"' -> ",{asis,Enc}]); -emit_enc_enumerated_case(Erules, _C, {1,EnumName}, Count) -> - %% ENUMERATED with extensionmark; the value is higher than extension root - Enc = enc_ext_and_val(Erules, 1, encode_small_number, [Count]), - emit(["'",EnumName,"' -> ",{asis,Enc}]); -emit_enc_enumerated_case(Erules, C, EnumName, Count) -> - %% ENUMERATED without extension - EvalMod = eval_module(Erules), - emit(["'",EnumName,"' -> ", - {asis,EvalMod:encode_constrained_number(C, Count)}]). - -enc_ext_and_val(per, E, F, Args) -> - [E|apply(asn1ct_eval_per, F, Args)]; -enc_ext_and_val(uper, E, F, Args) -> - Bs = list_to_bitstring([apply(asn1ct_eval_uper, F, Args)]), - <<E:1,Bs/bitstring>>. - - -%% Object code generating for encoding and decoding -%% ------------------------------------------------ - -gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) -> - ObjName = Obj#typedef.name, - Def = Obj#typedef.typespec, - #'Externaltypereference'{module=Mod,type=ClassName} = - Def#'Object'.classname, - Class = asn1_db:dbget(Mod,ClassName), - {object,_,Fields} = Def#'Object'.def, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjName}), - emit({nl,"%%================================",nl}), - EncConstructed = - gen_encode_objectfields(Erules, ClassName,get_class_fields(Class), - ObjName,Fields,[]), - emit(nl), - gen_encode_constr_type(Erules,EncConstructed), - emit(nl), - DecConstructed = - gen_decode_objectfields(Erules, ClassName, get_class_fields(Class), - ObjName, Fields, []), - emit(nl), - gen_decode_constr_type(Erules,DecConstructed), - emit(nl). - - -gen_encode_objectfields(Erule, ClassName, - [{typefield,Name,OptOrMand}|Rest], - ObjName, ObjectFields, ConstrAcc) -> - EmitFuncClause = - fun(V) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",V,",_RestPrimFieldName) ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val, _RestPrimFieldName) ->",nl]), - MaybeConstr = - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("Val"), - case Erule of - uper -> - emit(" Val"); - per -> - emit([" if",nl, - " is_list(Val) ->",nl, - " NewVal = list_to_binary(Val),",nl, - " [20,byte_size(NewVal),NewVal];",nl, - " is_binary(Val) ->",nl, - " [20,byte_size(Val),Val]",nl, - " end"]) - end, - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Val"), - gen_encode_default_call(Erule, ClassName, Name, DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Val"), - gen_encode_field_call(Erule, ObjName, Name, TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(Erule,ClassName,Rest,ObjName,ObjectFields, - MaybeConstr++ConstrAcc); -gen_encode_objectfields(Erule,ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> - CurrentMod = get(currmod), - EmitFuncClause = - fun(Attrs) -> - emit(["'enc_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'enc_",ObjName,"'(",{asis,Name}, -% ", Val,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_"), - emit([" exit({error,{'use of missing field in object', ",{asis,Name}, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,#'Externalvaluereference'{module=CurrentMod, - value=TypeName}},_} -> - EmitFuncClause(" Val, [H|T]"), - emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}); - {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> - EmitFuncClause(" Val, [H|T]"), - emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Val,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'enc_",TypeName, - "'(H, Val, T)"}); - TypeName -> - emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}) + case Constraint of + [#'Externaltypereference'{type=Tname}] -> + EncFunc = enc_func(Tname), + Imm = [{apply,EncFunc,[{expr,Val}]}], + asn1ct_imm:per_enc_open_type(Imm, Aligned); + [] -> + Imm = [{call,erlang,iolist_to_binary,[{expr,Val}]}], + asn1ct_imm:per_enc_open_type(Imm, Aligned) end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_encode_objectfields(Erule,ClassName,Rest,ObjName,ObjectFields,ConstrAcc); -gen_encode_objectfields(Erule,ClassName,[_C|Cs],O,OF,Acc) -> - gen_encode_objectfields(Erule,ClassName,Cs,O,OF,Acc); -gen_encode_objectfields(_, _,[],_,_,Acc) -> - Acc. - - -gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> - case is_already_generated(enc,TypeDef#typedef.name) of - true -> ok; - _ -> -%% FuncName = list_to_atom(lists:concat(["enc_",TypeDef#typedef.name])), - FuncName = asn1ct_gen:list2rname(TypeDef#typedef.name ++ [enc]), - emit(["'",FuncName,"'(Val) ->",nl]), - Def = TypeDef#typedef.typespec, - InnerType = asn1ct_gen:get_inner(Def#type.def), - asn1ct_gen:gen_encode_constructed(Erules,TypeDef#typedef.name, - InnerType,Def), - gen_encode_constr_type(Erules,Rest) - end; -gen_encode_constr_type(_,[]) -> - ok. - -gen_encode_field_call(_Erules, _ObjName, _FieldName, - #'Externaltypereference'{module=M,type=T}) -> - CurrentMod = get(currmod), - if - M == CurrentMod -> - emit({" 'enc_",T,"'(Val)"}), - []; - true -> - emit({" '",M,"':'enc_",T,"'(Val)"}), - [] - end; -gen_encode_field_call(Erules, ObjName, FieldName, Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_encode_prim(Erules, Def, "Val"), - []; - {constructed,bif} -> - emit({" 'enc_",ObjName,'_',FieldName, - "'(Val)"}), -%% [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - [Type#typedef{name=[FieldName,ObjName]}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'enc_",TypeName, - "'(Val)"}), - []; - TypeName -> - emit({" 'enc_",TypeName,"'(Val)"}), - [] end. -gen_encode_default_call(Erules, ClassName, FieldName, Type) -> - CurrentMod = get(currmod), - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> -%% asn1ct_gen:gen_encode_constructed(Erules,Typename,InnerType,Type); - emit([" 'enc_",ClassName,'_',FieldName,"'(Val)"]), -%% [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - [#typedef{name=[FieldName,ClassName], - typespec=Type}]; - {primitive,bif} -> - gen_encode_prim(Erules, Type, "Val"), - []; - #'Externaltypereference'{module=CurrentMod,type=Etype} -> - emit([" 'enc_",Etype,"'(Val)",nl]), - []; - #'Externaltypereference'{module=Emod,type=Etype} -> - emit([" '",Emod,"':'enc_",Etype,"'(Val)",nl]), - [] - end. - - -gen_decode_objectfields(Erules, ClassName, - [{typefield,Name,OptOrMand}|Rest], - ObjName, ObjectFields, ConstrAcc) -> - EmitFuncClause = - fun(Bytes) -> - emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes, - ",_,_RestPrimFieldName) ->",nl]) - end, - MaybeConstr= - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> %% this case is illegal - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("Bytes"), - emit([" {Bytes,[]}"]), - []; - {false,{'DEFAULT',DefaultType}} -> - EmitFuncClause("Bytes"), - gen_decode_default_call(Erules, ClassName, Name, "Bytes", - DefaultType); - {{Name,TypeSpec},_} -> - %% A specified field owerwrites any 'DEFAULT' or - %% 'OPTIONAL' field in the class - EmitFuncClause("Bytes"), - gen_decode_field_call(Erules, ObjName, Name, "Bytes", TypeSpec) - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(Erules, ClassName, Rest, ObjName, - ObjectFields, MaybeConstr++ConstrAcc); -gen_decode_objectfields(Erules, ClassName, - [{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName, ObjectFields, ConstrAcc) -> - CurrentMod = get(currmod), - EmitFuncClause = - fun(Attrs) -> - emit(["'dec_",ObjName,"'(",{asis,Name}, - ",",Attrs,") ->",nl]) - end, -% emit(["'dec_",ObjName,"'(",{asis,Name}, -% ", Bytes,_,[H|T]) ->",nl]), - case {get_object_field(Name,ObjectFields),OptOrMand} of - {false,'MANDATORY'} -> - exit({error,{asn1,{"missing mandatory field in object", - ObjName}}}); - {false,'OPTIONAL'} -> - EmitFuncClause("_,_,_"), - emit([" exit({error,{'illegal use of missing field in object', ",{asis,Name}, - "}})"]); - {false,{'DEFAULT',_DefaultObject}} -> - exit({error,{asn1,{"not implemented yet",Name}}}); - {{Name,#'Externalvaluereference'{module=CurrentMod, - value=TypeName}},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}); - {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - emit({indent(3),"'",M,"':'dec_",TypeName, - "'(H, Bytes, telltype, T)"}); - {{Name,TypeSpec},_} -> - EmitFuncClause("Bytes,_,[H|T]"), - case TypeSpec#typedef.name of - {ExtMod,TypeName} -> - emit({indent(3),"'",ExtMod,"':'dec_",TypeName, - "'(H, Bytes, telltype, T)"}); - TypeName -> - emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}) - end - end, - case more_genfields(Rest) of - true -> - emit([";",nl]); - false -> - emit([".",nl]) - end, - gen_decode_objectfields(Erules, ClassName, Rest, ObjName, - ObjectFields, ConstrAcc); -gen_decode_objectfields(Erules, CN, [_C|Cs], O, OF, CAcc) -> - gen_decode_objectfields(Erules, CN, Cs, O, OF, CAcc); -gen_decode_objectfields(_, _, [], _, _, CAcc) -> - CAcc. - - - -gen_decode_field_call(_Erules, _ObjName, _FieldName, Bytes, - #'Externaltypereference'{}=Etype) -> - emit(" "), - gen_dec_external(Etype, Bytes), - []; -gen_decode_field_call(Erules, ObjName, FieldName, Bytes, Type) -> - Def = Type#typedef.typespec, - case Type#typedef.name of - {primitive,bif} -> - gen_dec_prim(Erules, Def, Bytes), - []; - {constructed,bif} -> - emit({" 'dec_",ObjName,'_',FieldName, - "'(",Bytes,",telltype)"}), -%% [Type#typedef{name=list_to_atom(lists:concat([ObjName,'_',FieldName]))}]; - [Type#typedef{name=[FieldName,ObjName]}]; - {ExtMod,TypeName} -> - emit({" '",ExtMod,"':'dec_",TypeName, - "'(",Bytes,", telltype)"}), - []; - TypeName -> - emit({" 'dec_",TypeName,"'(",Bytes,", telltype)"}), - [] - end. - -gen_decode_default_call(Erules, ClassName, FieldName, Bytes, Type) -> - InnerType = asn1ct_gen:get_inner(Type#type.def), - case asn1ct_gen:type(InnerType) of - {constructed,bif} -> - emit([" 'dec_",ClassName,'_',FieldName,"'(",Bytes,", telltype)"]), -%% [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), - [#typedef{name=[FieldName,ClassName], - typespec=Type}]; - {primitive,bif} -> - gen_dec_prim(Erules, Type, Bytes), - []; - #'Externaltypereference'{}=Etype -> - asn1ct_gen_per:gen_dec_external(Etype, Bytes), - [] +dec_func(Tname) -> + list_to_atom(lists:concat(["dec_",Tname])). + +enc_func(Tname) -> + list_to_atom(lists:concat(["enc_",Tname])). + +simplify_type(Type) -> + case Type of + 'BMPString' -> k_m_string; + 'IA5String' -> k_m_string; + 'NumericString' -> k_m_string; + 'PrintableString' -> k_m_string; + 'VisibleString' -> k_m_string; + 'UniversalString' -> k_m_string; + 'GeneralizedTime' -> k_m_string; + 'UTCTime' -> k_m_string; + 'TeletexString' -> restricted_string; + 'T61String' -> restricted_string; + 'VideotexString' -> restricted_string; + 'GraphicString' -> restricted_string; + 'GeneralString' -> restricted_string; + 'UTF8String' -> restricted_string; + 'ObjectDescriptor' -> restricted_string; + Other -> Other end. +%% Object code generating for encoding and decoding +%% ------------------------------------------------ -gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> - case is_already_generated(dec,TypeDef#typedef.name) of - true -> ok; - _ -> - gen_decode(Erules,TypeDef#typedef{name=asn1ct_gen:list2rname(TypeDef#typedef.name)}) - end, - gen_decode_constr_type(Erules,Rest); -gen_decode_constr_type(_,[]) -> +gen_obj_code(_Erules, _Module, #typedef{}) -> ok. - -more_genfields([]) -> - false; -more_genfields([Field|Fields]) -> - case element(1,Field) of - typefield -> - true; - objectfield -> - true; - _ -> - more_genfields(Fields) - end. - %% Object Set code generating for encoding and decoding %% ---------------------------------------------------- -gen_objectset_code(Erules,ObjSet) -> - ObjSetName = ObjSet#typedef.name, - Def = ObjSet#typedef.typespec, -%% {ClassName,ClassDef} = Def#'ObjectSet'.class, - #'Externaltypereference'{module=ClassModule, - type=ClassName} = Def#'ObjectSet'.class, - ClassDef = asn1_db:dbget(ClassModule,ClassName), - UniqueFName = Def#'ObjectSet'.uniquefname, - Set = Def#'ObjectSet'.set, - emit({nl,nl,nl,"%%================================"}), - emit({nl,"%% ",ObjSetName}), - emit({nl,"%%================================",nl}), - case ClassName of - {_Module,ExtClassName} -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ExtClassName,ClassDef); - _ -> - gen_objset_code(Erules,ObjSetName,UniqueFName,Set, - ClassName,ClassDef) - end, - emit(nl). - -gen_objset_code(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> - ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, - InternalFuncs= - gen_objset_enc(Erules,ObjSetName,UniqueFName,Set,ClassName,ClassFields,1,[]), - gen_objset_dec(Erules, ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), - gen_internal_funcs(Erules,InternalFuncs). - -%% gen_objset_enc iterates over the objects of the object set -gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - []; -gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T], - ClName, ClFields, NthObj, Acc)-> - emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl]), - CurrMod = get(currmod), - {InternalFunc,NewNthObj}= - case ObjName of - {no_mod,no_name} -> - gen_inlined_enc_funs(Erule, Fields, ClFields, - ObjSetName, NthObj); - {CurrMod,Name} -> - emit({" fun 'enc_",Name,"'/3"}), - {[],0}; - {ModName,Name} -> - emit_ext_encfun(ModName,Name), - {[],0}; - _Other -> - emit({" fun 'enc_",ObjName,"'/3"}), - {[],0} - end, - emit({";",nl}), - gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields, - NewNthObj, InternalFunc ++ Acc); -gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'], - _ClName, _ClFields, _NthObj, Acc) -> - emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(_, Val, _) ->",nl}), - emit([indent(6),"Val",nl, - indent(3),"end.",nl,nl]), - Acc; -gen_objset_enc(per, ObjSetName, _UniqueName, ['EXTENSIONMARK'], - _ClName, _ClFields, _NthObj, Acc) -> - emit(["'getenc_",ObjSetName,"'(_, _) ->",nl, - indent(3),"fun(_, Val, _) ->",nl, - indent(6),"BinVal = if",nl, - indent(9),"is_list(Val) -> list_to_binary(Val);",nl, - indent(9),"true -> Val",nl, - indent(6),"end,",nl, - indent(6),"Size = byte_size(BinVal),",nl, - indent(6),"if",nl, - indent(9),"Size < 256 ->",nl, - indent(12),"[20,Size,BinVal];",nl, - indent(9),"true ->",nl, - indent(12),"[21,<<Size:16>>,Val]",nl, - indent(6),"end",nl, - indent(3),"end.",nl,nl]), - Acc; -gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) -> - emit_default_getenc(ObjSetName, UniqueName), - emit([".",nl,nl]), - Acc. - -emit_ext_encfun(ModuleName,Name) -> - emit([indent(4),"fun(T,V,O) -> '",ModuleName,"':'enc_", - Name,"'(T,V,O) end"]). - -emit_default_getenc(ObjSetName,UniqueName) -> - emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), - emit([indent(4),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). - - -%% gen_inlined_enc_funs for each object iterates over all fields of a -%% class, and for each typefield it checks if the object has that -%% field and emits the proper code. -gen_inlined_enc_funs(Erule, Fields, [{typefield,_,_}|_]=T, - ObjSetName, NthObj) -> - emit([indent(3),"fun(Type, Val, _) ->",nl, - indent(6),"case Type of",nl]), - gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, [], NthObj, []); -gen_inlined_enc_funs(Erule,Fields,[_H|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,_,[],_,NthObj) -> - {[],NthObj}. - -gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName, - Sep0, NthObj, Acc0) -> - emit(Sep0), - Sep = [";",nl], - CurrentMod = get(currmod), - InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), - {Acc,NAdd} = - case lists:keyfind(Name, 1, Fields) of - {_,#type{}=Type} -> - {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName), - {Ret++Acc0,N}; - {_,#typedef{}=Type} -> - emit([indent(9),{asis,Name}," ->",nl]), - {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName), - {Ret++Acc0,N}; - {_,#'Externaltypereference'{module=CurrentMod,type=T}} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'enc_",T,"'(Val)"]), - {Acc0,0}; - {_,#'Externaltypereference'{module=M,type=T}} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), - {Acc0,0}; - false when Erule =:= uper -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"Val",nl]), - {Acc0,0}; - false when Erule =:= per -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"Size = case Val of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, - indent(15),"_ -> length(Val)",nl, - indent(12),"end,",nl, - indent(12),"if",nl, - indent(15),"Size < 256 -> [20,Size,Val];",nl, - indent(15),"true -> [21,<<Size:16>>,Val]",nl, - indent(12),"end"]), - {Acc0,0} - end, - gen_inlined_enc_funs1(Erule, Fields, Rest, ObjSetName, Sep, - NthObj+NAdd, Acc); -gen_inlined_enc_funs1(Erule, Fields, [_|T], ObjSetName, Sep, NthObj, Acc)-> - gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, Sep, NthObj, Acc); -gen_inlined_enc_funs1(_, _, [], _, _, NthObj, Acc) -> - emit([nl,indent(6),"end",nl, - indent(3),"end"]), - {Acc,NthObj}. - -emit_inner_of_fun(Erule, #typedef{name={ExtMod,Name},typespec=Type}=TDef, - InternalDefFunName) -> - case {ExtMod,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_encode_prim(Erule, Type, "Val"), - {[],0}; - {constructed,bif} -> - emit([indent(12),"'enc_", - InternalDefFunName,"'(Val)"]), - {[TDef#typedef{name=InternalDefFunName}],1}; - _ -> - emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}), - {[],0} - end; -emit_inner_of_fun(_Erule, #typedef{name=Name}, _) -> - emit({indent(12),"'enc_",Name,"'(Val)"}), - {[],0}; -emit_inner_of_fun(Erule, #type{}=Type, _) -> - CurrMod = get(currmod), - case Type#type.def of - Def when is_atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_encode_prim(Erule, Type, "Val"); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", - T,"'(Val)"}) - end, - {[],0}. - -indent(N) -> - lists:duplicate(N,32). % 32 = space - - -gen_objset_dec(_, _, {unique,undefined}, _, _, _, _) -> - %% There is no unique field in the class of this object set - %% don't bother about the constraint - ok; -gen_objset_dec(Erule, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName, - ClFields, NthObj)-> - emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), - CurrMod = get(currmod), - NewNthObj= - case ObjName of - {no_mod,no_name} -> - gen_inlined_dec_funs(Erule, Fields, ClFields, - ObjSName, NthObj); - {CurrMod,Name} -> - emit([" fun 'dec_",Name,"'/4"]), - NthObj; - {ModName,Name} -> - emit_ext_decfun(ModName,Name), - NthObj; - _Other -> - emit({" fun 'dec_",ObjName,"'/4"}), - NthObj - end, - emit({";",nl}), - gen_objset_dec(Erule, ObjSName, UniqueName, T, ClName, ClFields, NewNthObj); -gen_objset_dec(_Erule, ObjSetName, _UniqueName, ['EXTENSIONMARK'], - _ClName, _ClFields, _NthObj) -> - emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), - emit({indent(3),"fun(Attr1, Bytes, _,_) ->",nl}), - emit({indent(6),"{Bytes,Attr1}",nl}), - emit({indent(3),"end.",nl,nl}), - ok; -gen_objset_dec(_Erule, ObjSetName, UniqueName, [], _, _, _) -> - emit_default_getdec(ObjSetName, UniqueName), - emit([".",nl,nl]), +gen_objectset_code(_Erules, _ObjSet) -> ok. -emit_ext_decfun(ModuleName,Name) -> - emit([indent(3),"fun(T,V,O1,O2) -> '",ModuleName,"':'dec_", - Name,"'(T,V,O1,O2) end"]). - -emit_default_getdec(ObjSetName,UniqueName) -> - emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), - emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). - - -gen_inlined_dec_funs(Erule, Fields, List, ObjSetName, NthObj0) -> - emit([indent(3),"fun(Type, Val, _, _) ->",nl, - indent(6),"case Type of",nl]), - NthObj = gen_inlined_dec_funs1(Erule, Fields, List, - ObjSetName, "", NthObj0), - emit([nl,indent(6),"end",nl, - indent(3),"end"]), - NthObj. - -gen_inlined_dec_funs1(Erule, Fields, [{typefield,Name,_}|Rest], - ObjSetName, Sep0, NthObj) -> - InternalDefFunName = [NthObj,Name,ObjSetName], - emit(Sep0), - Sep = [";",nl], - N = case lists:keyfind(Name, 1, Fields) of - {_,#type{}=Type} -> - emit_inner_of_decfun(Erule, Type, InternalDefFunName); - {_,#typedef{}=Type} -> - emit([indent(9),{asis,Name}," ->",nl]), - emit_inner_of_decfun(Erule, Type, InternalDefFunName); - {_,#'Externaltypereference'{}=Etype} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12)]), - gen_dec_external(Etype, "Val"), - 0; - false -> - emit([indent(9),{asis,Name}," -> {Val,Type}"]), - 0 - end, - gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj+N); -gen_inlined_dec_funs1(Erule, Fields, [_|Rest], ObjSetName, Sep, NthObj) -> - gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj); -gen_inlined_dec_funs1(_, _, [], _, _, NthObj) -> NthObj. - -emit_inner_of_decfun(Erule, #typedef{name={ExtName,Name},typespec=Type}, - InternalDefFunName) -> - case {ExtName,Name} of - {primitive,bif} -> - emit(indent(12)), - gen_dec_prim(Erule, Type, "Val"), - 0; - {constructed,bif} -> - emit({indent(12),"'dec_", - asn1ct_gen:list2name(InternalDefFunName),"'(Val)"}), - 1; - _ -> - emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Val, telltype)"}), - 0 - end; -emit_inner_of_decfun(_Erule, #typedef{name=Name}, _) -> - emit({indent(12),"'dec_",Name,"'(Val, telltype)"}), - 0; -emit_inner_of_decfun(Erule, #type{}=Type, _) -> - CurrMod = get(currmod), - case Type#type.def of - Def when is_atom(Def) -> - emit({indent(9),Def," ->",nl,indent(12)}), - gen_dec_prim(Erule, Type, "Val"); - #'Externaltypereference'{module=CurrMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); - #'Externaltypereference'{module=ExtMod,type=T} -> - emit({indent(9),T," ->",nl,indent(12),ExtMod,":'dec_", - T,"'(Val)"}) - end, - 0. - - -gen_internal_funcs(_,[]) -> - ok; -gen_internal_funcs(Erules,[TypeDef|Rest]) -> - gen_encode_user(Erules,TypeDef), - emit([nl,nl,"'dec_",TypeDef#typedef.name,"'(Bytes) ->",nl]), - gen_decode_user(Erules,TypeDef), - gen_internal_funcs(Erules,Rest). - - - %% DECODING ***************************** %%*************************************** -gen_decode(Erules,Type) when is_record(Type,typedef) -> - D = Type, - emit({nl,nl}), - emit({"'dec_",Type#typedef.name,"'(Bytes,_) ->",nl}), +gen_decode(Erules, #typedef{}=Type) -> + DecFunc = dec_func(Type#typedef.name), + emit([nl,nl,{asis,DecFunc},"(Bytes) ->",nl]), dbdec(Type#typedef.name), - gen_decode_user(Erules,D). + gen_decode_user(Erules, Type). gen_decode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> NewTname = [Cname|Tname], @@ -944,8 +218,9 @@ gen_decode(Erules,Typename,Type) when is_record(Type,type) -> _ -> "" end, - emit({nl,"'dec_",asn1ct_gen:list2name(Typename), - "'(Bytes,_",ObjFun,") ->",nl}), + emit([nl, + {asis,dec_func(asn1ct_gen:list2name(Typename))}, + "(Bytes",ObjFun,") ->",nl]), dbdec(Typename), asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); _ -> @@ -982,8 +257,8 @@ gen_dec_external(Ext, BytesVar) -> #'Externaltypereference'{module=Mod,type=Type} = Ext, emit([case CurrMod of Mod -> []; - _ -> ["'",Mod,"':"] - end,"'dec_",Type,"'(",BytesVar,",telltype)"]). + _ -> [{asis,Mod},":"] + end,{asis,dec_func(Type)},"(",BytesVar,")"]). gen_dec_imm(Erule, #type{def=Name,constraint=C}) -> Aligned = case Erule of @@ -1103,35 +378,6 @@ gen_dec_prim(Erule, Type, BytesVar) -> Imm = gen_dec_imm(Erule, Type), asn1ct_imm:dec_code_gen(Imm, BytesVar). -is_already_generated(Operation,Name) -> - case get(class_default_type) of - undefined -> - put(class_default_type,[{Operation,Name}]), - false; - GeneratedList -> - case lists:member({Operation,Name},GeneratedList) of - true -> - true; - false -> - put(class_default_type,[{Operation,Name}|GeneratedList]), - false - end - end. - -get_class_fields(#classdef{typespec=ObjClass}) -> - ObjClass#objectclass.fields; -get_class_fields(#objectclass{fields=Fields}) -> - Fields; -get_class_fields(_) -> - []. - - -get_object_field(Name,ObjectFields) -> - case lists:keysearch(Name,1,ObjectFields) of - {value,Field} -> Field; - false -> false - end. - %% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding %% the components within the ExtensionAdditionGroup is treated in a similar way as if they @@ -1170,11 +416,8 @@ imm_dec_open_type_1(Type, Aligned) -> asn1ct_name:new(tmpval), emit(["begin",nl, "{",{curr,tmpval},",_} = ", - "dec_",Type,"(",OpenType,", mandatory),",nl, + {asis,dec_func(Type)},"(",OpenType,"),",nl, "{",{curr,tmpval},com,Buf,"}",nl, "end"]) end, {call,D,asn1ct_imm:per_dec_open_type(Aligned)}. - -eval_module(per) -> asn1ct_eval_per; -eval_module(uper) -> asn1ct_eval_uper. |