From 70e82386dab6591a57c1e4787ae78919e3fe02d1 Mon Sep 17 00:00:00 2001 From: George Mamais Date: Wed, 25 Dec 2024 01:59:55 +0200 Subject: [PATCH] various compilation speed improvements --- BackendAst/DAstACN.fs | 128 ++++++++++++----------- BackendAst/DAstConstruction.fs | 46 ++++---- BackendAst/DAstInitialize.fs | 174 ++++++++++++++++++------------- BackendAst/DAstTypeDefinition.fs | 12 ++- BackendAst/DAstUPer.fs | 4 +- BackendAst/DAstVariables.fs | 12 +-- CommonTypes/CommonTypes.fs | 5 +- FrontEndAst/DAst.fs | 14 ++- FrontEndAst/LspAst.fs | 5 +- asn1scc/Program.fs | 6 +- 10 files changed, 225 insertions(+), 181 deletions(-) diff --git a/BackendAst/DAstACN.fs b/BackendAst/DAstACN.fs index d9313c9d2..0073551e4 100644 --- a/BackendAst/DAstACN.fs +++ b/BackendAst/DAstACN.fs @@ -183,20 +183,6 @@ let handleAlignmentForAcnTypes (r:Asn1AcnAst.AstRoot) let md5 = System.Security.Cryptography.MD5.Create() let createIcdTas (r:Asn1AcnAst.AstRoot) (id:ReferenceToType) (icdAux:IcdArgAux) (td:FE_TypeDefinition) (typeDefinition:TypeDefinitionOrReference) nMinBytesInACN nMaxBytesInACN hasAcnDefinition = - (* - Slow Implementation. It has been replaced by CalculateIcdHash.fs. - We keep it here for reference. - let calcIcdTypeAssHash (t1:IcdTypeAss) = - let calcIcdTypeAssHash_aux (t1:IcdTypeAss) = - let rws = - t1.rows |> - Seq.map(fun r -> sprintf "%A%A%A%A%A%A%A%A%A%A" r.idxOffset r.fieldName r.comments r.sPresent r.sType r.sConstraint r.minLengthInBits r.maxLengthInBits r.sUnits r.rowType) |> - Seq.StrJoin "" - let aa = sprintf"%A%A%A%A%A%A%A%A%A" t1.acnLink t1.asn1Link t1.name t1.kind t1.comments t1.minLengthInBytes t1.maxLengthInBytes (rws) ("") - let bytes = md5.ComputeHash(System.Text.Encoding.UTF8.GetBytes aa) - Convert.ToHexString bytes - calcIcdTypeAssHash_aux t1 - *) let icdRows, compositeChildren = icdAux.rowsFunc "" "" []; let icdTas = { @@ -216,12 +202,18 @@ let createIcdTas (r:Asn1AcnAst.AstRoot) (id:ReferenceToType) (icdAux:IcdArgAux) match id.tasInfo with | None -> [] | Some tasInfo -> + (* match r.Modules |> Seq.tryFind(fun m -> m.Name.Value = tasInfo.modName) with | None -> [] | Some m -> match m.TypeAssignments |> Seq.tryFind(fun ts -> ts.Name.Value = tasInfo.tasName) with | None -> [] | Some ts -> ts.Comments |> Seq.toList + *) + match r.typeAssignmentsMap.TryFind (tasInfo.modName, tasInfo.tasName) with + | None -> [] + | Some ts -> ts.Comments |> Seq.toList + asn1Comments@icdAux.commentsForTas rows = icdRows compositeChildren = compositeChildren @@ -296,12 +288,18 @@ let private createAcnFunction (r: Asn1AcnAst.AstRoot) | Scala -> None, None, [], None, ns | _ -> - let content, ns1a = funcBody ns errCode [] (NestingScope.init t.acnMaxSizeInBits t.uperMaxSizeInBits []) p - let icdResult = - match content with - | None -> None - | Some bodyResult -> bodyResult.icdResult - None, None, [], icdResult, ns1a + match r.args.generateAcnIcd with + | false -> + None, None, [], None, ns + | true -> + //the call to funcBody is necessary to get the correct nesting scope + //however, it is expensive to call so we only call it if we need to generate the ICD + let content, ns1a = funcBody ns errCode [] (NestingScope.init t.acnMaxSizeInBits t.uperMaxSizeInBits []) p + let icdResult = + match content with + | None -> None + | Some bodyResult -> bodyResult.icdResult + None, None, [], icdResult, ns1a | Some funcName -> let precondAnnots = lm.lg.generatePrecond r ACN t codec let postcondAnnots = lm.lg.generatePostcond r ACN funcNameBase p t codec @@ -639,12 +637,12 @@ let createEnumCommon (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDe let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (icdStgFileName:string) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (defOrRef:TypeDefinitionOrReference) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (uperFunc: UPerFunction) (us:State) = - let typeDefinitionName = defOrRef.longTypedefName2 lm.lg.hasModules //getTypeDefinitionName t.id.tasInfo typeDefinition - let funcBodyOrig = createEnumCommon r deps lm codec t.id o defOrRef typeDefinitionName icdStgFileName None t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure let funcBody (errCode: ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p: CallerScope) = + let typeDefinitionName = defOrRef.longTypedefName2 lm.lg.hasModules //getTypeDefinitionName t.id.tasInfo typeDefinition + let funcBodyOrig = createEnumCommon r deps lm codec t.id o defOrRef typeDefinitionName icdStgFileName None t.acnMinSizeInBits t.acnMaxSizeInBits t.unitsOfMeasure let res = funcBodyOrig errCode acnArgs nestingScope p res |> Option.map (fun res -> let aux = lm.lg.generateEnumAuxiliaries r ACN t o nestingScope p.arg codec @@ -2007,7 +2005,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi // Copy-decoding expects to have a result expression (even if unused), so we pick the initExpression let childResultExpr = match codec, lm.lg.decodingKind with - | Decode, Copy -> Some child.Type.initFunction.initExpression + | Decode, Copy -> Some (child.Type.initFunction.initExpressionFnc ()) | _ -> None match child.Optionality with | Some Asn1AcnAst.AlwaysPresent -> @@ -2319,7 +2317,7 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel let uperSiblingMaxSize = children |> List.map (fun c -> c.chType.uperMaxSizeInBits) |> List.max let handleChild (us:State) (idx:int) (child:ChChildInfo) = let chFunc = child.chType.getAcnFunction codec - let sChildInitExpr = child.chType.initFunction.initExpression + let sChildInitExpr = child.chType.initFunction.initExpressionFnc () let childNestingScope = {nestingScope with nestingLevel = nestingScope.nestingLevel + 1I @@ -2438,11 +2436,12 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFiel createAcnFunction r deps lm codec t typeDefinition isValidFunc funcBody (fun atc -> true) soSparkAnnotations [] us, ec +let emptyIcdFnc fieldName sPresent comments = [],[] let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (codec:CommonTypes.Codec) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.ReferenceType) (typeDefinition:TypeDefinitionOrReference) (isValidFunc: IsValidFunction option) (baseType:Asn1Type) (us:State) = let baseTypeDefinitionName, baseFncName = getBaseFuncName lm typeDefinition o t.id "_ACN" codec - let td = lm.lg.getTypeDefinition t.FT_TypeDefinition + //let td = lm.lg.getTypeDefinition t.FT_TypeDefinition let getNewSType (r:IcdRow) = (* let newType = @@ -2455,41 +2454,40 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF r let icdFnc,extraComment, name = - match o.encodingOptions with - | None -> - let name = - match o.hasExtraConstrainsOrChildrenOrAcnArgs with - | false -> None - | true -> Some t.id.AsString.RDD - match baseType.icdTas with - | Some baseTypeIcdTas -> - let icdFnc fieldName sPresent comments = - let rows, comp = baseTypeIcdTas.createRowsFunc fieldName sPresent comments - rows |> List.map(fun r -> getNewSType r), comp - - icdFnc, baseTypeIcdTas.comments, name - | None -> - let icdFnc fieldName sPresent comments = [],[] - icdFnc, [], name - - | Some encOptions -> - let lengthDetRow = - match encOptions.acnEncodingClass with - | SZ_EC_LENGTH_EMBEDDED nSizeInBits -> - let sCommentUnit = match encOptions.octOrBitStr with ContainedInOctString -> "bytes" | ContainedInBitString -> "bits" - - [ {IcdRow.fieldName = "Length"; comments = [$"The number of {sCommentUnit} used in the encoding"]; sPresent="always";sType=IcdPlainType "INTEGER"; sConstraint=None; minLengthInBits = nSizeInBits ;maxLengthInBits=nSizeInBits;sUnits=None; rowType = IcdRowType.LengthDeterminantRow; idxOffset = None}] - | _ -> [] - match baseType.icdTas with - | Some baseTypeIcdTas -> - let icdFnc fieldName sPresent comments = - let rows0, compChildren = baseTypeIcdTas.createRowsFunc fieldName sPresent comments - let rows = rows0 |> List.map getNewSType - lengthDetRow@rows |> List.mapi(fun i r -> {r with idxOffset = Some (i+1)}), compChildren - icdFnc, ("OCTET STING CONTAINING BY"::baseTypeIcdTas.comments), Some (t.id.AsString.RDD + "_OCT_STR" ) + match r.args.generateAcnIcd with + | true -> + match o.encodingOptions with | None -> - let icdFnc fieldName sPresent comments = [],[] - icdFnc, [], None + let name = + match o.hasExtraConstrainsOrChildrenOrAcnArgs with + | false -> None + | true -> Some t.id.AsString.RDD + match baseType.icdTas with + | Some baseTypeIcdTas -> + let icdFnc fieldName sPresent comments = + let rows, comp = baseTypeIcdTas.createRowsFunc fieldName sPresent comments + rows |> List.map(fun r -> getNewSType r), comp + + icdFnc, baseTypeIcdTas.comments, name + | None -> emptyIcdFnc, [], name + + | Some encOptions -> + let lengthDetRow = + match encOptions.acnEncodingClass with + | SZ_EC_LENGTH_EMBEDDED nSizeInBits -> + let sCommentUnit = match encOptions.octOrBitStr with ContainedInOctString -> "bytes" | ContainedInBitString -> "bits" + + [ {IcdRow.fieldName = "Length"; comments = [$"The number of {sCommentUnit} used in the encoding"]; sPresent="always";sType=IcdPlainType "INTEGER"; sConstraint=None; minLengthInBits = nSizeInBits ;maxLengthInBits=nSizeInBits;sUnits=None; rowType = IcdRowType.LengthDeterminantRow; idxOffset = None}] + | _ -> [] + match baseType.icdTas with + | Some baseTypeIcdTas -> + let icdFnc fieldName sPresent comments = + let rows0, compChildren = baseTypeIcdTas.createRowsFunc fieldName sPresent comments + let rows = rows0 |> List.map getNewSType + lengthDetRow@rows |> List.mapi(fun i r -> {r with idxOffset = Some (i+1)}), compChildren + icdFnc, ("OCTET STING CONTAINING BY"::baseTypeIcdTas.comments), Some (t.id.AsString.RDD + "_OCT_STR" ) + | None -> emptyIcdFnc, [], None + | false -> emptyIcdFnc, [], None let icd = @@ -2503,6 +2501,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF match o.hasExtraConstrainsOrChildrenOrAcnArgs with | true -> // TODO: this is where stuff gets inlined + TL "ACN_REF_01" (fun () -> match codec with | Codec.Encode -> baseType.getAcnFunction codec, us | Codec.Decode -> @@ -2516,9 +2515,10 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF baseTypeAcnFunction.funcBody us (acnArgs@paramsArgsPairs) nestingScope p Some {baseTypeAcnFunction with funcBody = funcBody} - ret, us + ret, us) | false -> let funcBody (us:State) (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = + TL "ACN_REF_02" (fun () -> let pp, resultExpr = let str = lm.lg.getParamValue t p.arg codec match codec, lm.lg.decodingKind with @@ -2527,7 +2527,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF toc, Some toc | _ -> str, None let funcBodyContent = callBaseTypeFunc lm pp baseFncName codec - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; auxiliaries=[]; icdResult = icd}), us + Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; auxiliaries=[]; icdResult = icd}), us) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) @@ -2536,6 +2536,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF | Some encOptions -> //contained type i.e. MyOct ::= OCTET STRING (CONTAINING Other-Type) + TL "ACN_REF_03" (fun () -> let loc = o.tasName.Location let sReqBytesForUperEncoding = sprintf "%s_REQUIRED_BYTES_FOR_ACN_ENCODING" baseTypeDefinitionName let sReqBitForUperEncoding = sprintf "%s_REQUIRED_BITS_FOR_ACN_ENCODING" baseTypeDefinitionName @@ -2548,6 +2549,7 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF let baseTypeAcnFunction = baseType.getAcnFunction codec let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) = + TL "ACN_REF_04" (fun () -> let pp, resultExpr = let str = lm.lg.getParamValue t p.arg codec match codec, lm.lg.decodingKind with @@ -2597,8 +2599,8 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF let fncBody = bit_string_containing_func pp baseFncName sReqBytesForUperEncoding sReqBitForUperEncoding nBits encOptions.minSize.acn encOptions.maxSize.acn false codec fncBody, [errCode],[] | SZ_EC_TerminationPattern nullVal , _ -> raise(SemanticError (loc, "Invalid type for parameter4")) - Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; auxiliaries=[]; icdResult = icd}) + Some ({AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = errCodes; localVariables = localVariables; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; auxiliaries=[]; icdResult = icd})) let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec) let a,b = createAcnFunction r deps lm codec t typeDefinition isValidFunc (fun us e acnArgs nestingScope p -> funcBody e acnArgs nestingScope p, us) (fun atc -> true) soSparkAnnotations [] us - Some a, b + Some a, b) diff --git a/BackendAst/DAstConstruction.fs b/BackendAst/DAstConstruction.fs index 622f94680..bb7809a11 100644 --- a/BackendAst/DAstConstruction.fs +++ b/BackendAst/DAstConstruction.fs @@ -411,32 +411,28 @@ let private createBoolean (r:Asn1AcnAst.AstRoot) (deps: Asn1AcnAst.AcnInsertedFi let private createEnumerated (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps: Asn1AcnAst.AcnInsertedFieldDependencies) (lm:LanguageMacros) (m:Asn1AcnAst.Asn1Module) (pi : Asn1Fold.ParentInfo option) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (us:State) = - //let typeDefinition = DAstTypeDefinition.createEnumerated r l t o us - let defOrRef = DAstTypeDefinition.createEnumerated_u r lm t o us - let equalFunction = DAstEqual.createEnumeratedEqualFunction r lm t o defOrRef - let initialValue =o.items.Head.Name.Value - let initFunction = DAstInitialize.createEnumeratedInitFunc r lm t o defOrRef (EnumValue initialValue) - let isValidFunction, s1 = DastValidate2.createEnumeratedFunction r lm t o defOrRef us - let uperEncFunction, s2 = DAstUPer.createEnumeratedFunction r lm Codec.Encode t o defOrRef None isValidFunction s1 - let uperDecFunction, s3 = DAstUPer.createEnumeratedFunction r lm Codec.Decode t o defOrRef None isValidFunction s2 - - let acnEncFunction, s4 = DAstACN.createEnumeratedFunction r deps icdStgFileName lm Codec.Encode t o defOrRef defOrRef isValidFunction uperEncFunction s3 - let acnDecFunction, s5 = DAstACN.createEnumeratedFunction r deps icdStgFileName lm Codec.Decode t o defOrRef defOrRef isValidFunction uperDecFunction s4 - - let uperEncDecTestFunc,s6 = EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5 - let acnEncDecTestFunc ,s7 = EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6 - let automaticTestCasesValues = EncodeDecodeTestCase.EnumeratedAutomaticTestCaseValues r t o |> List.mapi (fun i x -> createAsn1ValueFromValueKind t i (EnumValue x)) - let xerEncFunction, s8 = XER r (fun () -> DAstXer.createEnumeratedFunction r lm Codec.Encode t o defOrRef isValidFunction s7) s7 - let xerDecFunction, s9 = XER r (fun () -> DAstXer.createEnumeratedFunction r lm Codec.Decode t o defOrRef isValidFunction s8) s8 - let xerEncDecTestFunc,s10 = EncodeDecodeTestCase.createXerEncDecFunction r lm t defOrRef equalFunction isValidFunction xerEncFunction xerDecFunction s9 - + let defOrRef = TL "EN_01" (fun () -> DAstTypeDefinition.createEnumerated_u r lm t o us) + let equalFunction = TL "EN_02" (fun () -> DAstEqual.createEnumeratedEqualFunction r lm t o defOrRef) + let initFunction = TL "EN_03" (fun () -> DAstInitialize.createEnumeratedInitFunc r lm t o defOrRef (EnumValue initialValue)) + let isValidFunction, s1 = TL "EN_04" (fun () -> DastValidate2.createEnumeratedFunction r lm t o defOrRef us) + let uperEncFunction, s2 = TL "EN_05" (fun () -> DAstUPer.createEnumeratedFunction r lm Codec.Encode t o defOrRef None isValidFunction s1) + let uperDecFunction, s3 = TL "EN_06" (fun () -> DAstUPer.createEnumeratedFunction r lm Codec.Decode t o defOrRef None isValidFunction s2) + let acnEncFunction, s4 = TL "EN_07" (fun () -> DAstACN.createEnumeratedFunction r deps icdStgFileName lm Codec.Encode t o defOrRef defOrRef isValidFunction uperEncFunction s3) + let acnDecFunction, s5 = TL "EN_08" (fun () -> DAstACN.createEnumeratedFunction r deps icdStgFileName lm Codec.Decode t o defOrRef defOrRef isValidFunction uperDecFunction s4) + let uperEncDecTestFunc,s6 = TL "EN_09" (fun () -> EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5) + let acnEncDecTestFunc ,s7 = TL "EN_10" (fun () -> EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6) +// let automaticTestCasesValues TL "EN_11" (fun () -> = EncodeDecodeTestCase.EnumeratedAutomaticTestCaseValues r t o |> List.mapi (fun i x -> createAsn1ValueFromValueKind t i (EnumValue x))) + let xerEncFunction, s8 = TL "EN_12" (fun () -> XER r (fun () -> DAstXer.createEnumeratedFunction r lm Codec.Encode t o defOrRef isValidFunction s7) s7) + let xerDecFunction, s9 = TL "EN_13" (fun () -> XER r (fun () -> DAstXer.createEnumeratedFunction r lm Codec.Decode t o defOrRef isValidFunction s8) s8) + let xerEncDecTestFunc,s10 = TL "EN_14" (fun () -> EncodeDecodeTestCase.createXerEncDecFunction r lm t defOrRef equalFunction isValidFunction xerEncFunction xerDecFunction s9) + let printValue = TL "EN_15" (fun () -> DAstVariables.createEnumeratedFunction r lm t o defOrRef) let ret = { Enumerated.baseInfo = o //typeDefinition = typeDefinition definitionOrRef = defOrRef - printValue = DAstVariables.createEnumeratedFunction r lm t o defOrRef + printValue = printValue //initialValue = initialValue initFunction = initFunction equalFunction = equalFunction @@ -630,12 +626,12 @@ let private createSequence (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedFi let defOrRef = TL "SQ_DAstTypeDefinition" (fun () -> DAstTypeDefinition.createSequence_u r lm t o children us) let equalFunction = TL "SQ_DAstEqual" (fun () -> DAstEqual.createSequenceEqualFunction r lm t o defOrRef children) let initFunction = TL "SQ_DAstInitialize" (fun () -> DAstInitialize.createSequenceInitFunc r lm t o defOrRef children ) - let isValidFunction, s1 = TL "SQ_DAstInitialize" (fun () -> DastValidate2.createSequenceFunction r lm t o defOrRef children us) + let isValidFunction, s1 = TL "SQ_DastValidate2" (fun () -> DastValidate2.createSequenceFunction r lm t o defOrRef children us) - let uperEncFunction, s2 = TL "SQ_DAstUPer" (fun () ->DAstUPer.createSequenceFunction r lm Codec.Encode t o defOrRef isValidFunction children s1) - let uperDecFunction, s3 = TL "SQ_DAstUPer" (fun () ->DAstUPer.createSequenceFunction r lm Codec.Decode t o defOrRef isValidFunction children s2) - let acnEncFunction, s4 = TL "SQ_DAstACN" (fun () ->DAstACN.createSequenceFunction r deps lm Codec.Encode t o defOrRef isValidFunction children newPrms s3) - let acnDecFunction, s5 = TL "SQ_DAstACN" (fun () ->DAstACN.createSequenceFunction r deps lm Codec.Decode t o defOrRef isValidFunction children newPrms s4) + let uperEncFunction, s2 = TL "SQ_DAstUPer_encode" (fun () ->DAstUPer.createSequenceFunction r lm Codec.Encode t o defOrRef isValidFunction children s1) + let uperDecFunction, s3 = TL "SQ_DAstUPer_decode" (fun () ->DAstUPer.createSequenceFunction r lm Codec.Decode t o defOrRef isValidFunction children s2) + let acnEncFunction, s4 = TL "SQ_DAstACN_encode" (fun () ->DAstACN.createSequenceFunction r deps lm Codec.Encode t o defOrRef isValidFunction children newPrms s3) + let acnDecFunction, s5 = TL "SQ_DAstACN_decode" (fun () ->DAstACN.createSequenceFunction r deps lm Codec.Decode t o defOrRef isValidFunction children newPrms s4) let uperEncDecTestFunc,s6 = TL "SQ_EncodeDecodeTestCase" (fun () ->EncodeDecodeTestCase.createUperEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some uperEncFunction) (Some uperDecFunction) s5) let acnEncDecTestFunc ,s7 = TL "SQ_EncodeDecodeTestCase" (fun () ->EncodeDecodeTestCase.createAcnEncDecFunction r lm t defOrRef equalFunction isValidFunction (Some acnEncFunction) (Some acnDecFunction) s6) let xerEncFunction, s8 = TL "SQ_DAstXer" (fun () ->XER r (fun () -> DAstXer.createSequenceFunction r lm Codec.Encode t o defOrRef isValidFunction children s7) s7) diff --git a/BackendAst/DAstInitialize.fs b/BackendAst/DAstInitialize.fs index 7b371c7f1..02996eb9b 100644 --- a/BackendAst/DAstInitialize.fs +++ b/BackendAst/DAstInitialize.fs @@ -172,7 +172,7 @@ let getFuncName2 (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (typeDefinition:Typ let createInitFunctionCommon (r: Asn1AcnAst.AstRoot) (lm: LanguageMacros) (o: Asn1AcnAst.Asn1Type) (typeDefinition:TypeDefinitionOrReference) initByAsn1Value (initTasFunction: CallerScope -> InitFunctionResult) - automaticTestCases (initExpression: string) (initExpressionGlobal: string) (nonEmbeddedChildrenFuncs: InitFunction list) (user_aux_functions: (string*string) list) (funcDefAnnots: string list) = + automaticTestCases (initExpressionFnc: unit -> string) (initExpressionGlobalFnc: unit -> string) (nonEmbeddedChildrenFuncs: InitFunction list) (user_aux_functions: (string*string) list) (funcDefAnnots: string list) = let funcName = getFuncName2 r lm typeDefinition let globalName = getFuncNameGeneric typeDefinition "_constant" @@ -186,31 +186,36 @@ let createInitFunctionCommon (r: Asn1AcnAst.AstRoot) (lm: LanguageMacros) (o: As let initDef = lm.init.initTypeConstant_def let initBody = lm.init.initTypeConstant_body let tdName = lm.lg.getLongTypedefName typeDefinition - let initProcedure = + let initProcedure, initFunction, initGlobal = match funcName with - | None -> None + | None -> None, None, None | Some funcName -> - match r.args.generateConstInitGlobals && globalName.IsSome with - | true -> - let funcBody = lm.init.assignAny (lm.lg.getValue p.arg) globalName.Value tdName - let func = initTypeAssignment varName sPtrPrefix sPtrSuffix funcName tdName funcBody [] initExpression funcDefAnnots - let funcDef = initTypeAssignment_def varName sStar funcName (lm.lg.getLongTypedefName typeDefinition) - Some {InitProcedure0.funcName = funcName; def = funcDef; body=func} - | false -> - let res = initTasFunction p - let lvars = res.localVariables |> List.map(fun (lv:LocalVariable) -> lm.lg.getLocalVariableDeclaration lv) |> List.distinct - let func = initTypeAssignment varName sPtrPrefix sPtrSuffix funcName tdName res.funcBody lvars initExpression funcDefAnnots - let funcDef = initTypeAssignment_def varName sStar funcName (lm.lg.getLongTypedefName typeDefinition) - Some {InitProcedure0.funcName = funcName; def = funcDef; body=func} + let initExpression = initExpressionFnc () + let initExpressionGlobal = initExpressionGlobalFnc () + let initProc = + match r.args.generateConstInitGlobals && globalName.IsSome with + | true -> + let funcBody = lm.init.assignAny (lm.lg.getValue p.arg) globalName.Value tdName + let func = initTypeAssignment varName sPtrPrefix sPtrSuffix funcName tdName funcBody [] initExpression funcDefAnnots + let funcDef = initTypeAssignment_def varName sStar funcName (lm.lg.getLongTypedefName typeDefinition) + Some {InitProcedure0.funcName = funcName; def = funcDef; body=func} + | false -> + let res = initTasFunction p + let lvars = res.localVariables |> List.map(fun (lv:LocalVariable) -> lm.lg.getLocalVariableDeclaration lv) |> List.distinct + let func = initTypeAssignment varName sPtrPrefix sPtrSuffix funcName tdName res.funcBody lvars initExpression funcDefAnnots + let funcDef = initTypeAssignment_def varName sStar funcName (lm.lg.getLongTypedefName typeDefinition) + Some {InitProcedure0.funcName = funcName; def = funcDef; body=func} + let initFunction = {InitProcedure0.funcName = funcName; def = initDef tdName funcName initExpression; body=initBody tdName funcName initExpression} + let initGlobal = + globalName |> Option.map(fun n -> {InitGlobal.globalName = n; def = initDef tdName n initExpressionGlobal; body=initBody tdName n initExpressionGlobal}) + initProc, Some initFunction, initGlobal { - initExpression = initExpression - initExpressionGlobal = initExpressionGlobal - initProcedure = initProcedure - initFunction = - funcName |> Option.map(fun n -> {InitProcedure0.funcName = n; def = initDef tdName n initExpression; body=initBody tdName n initExpression}) - initGlobal = - globalName |> Option.map(fun n -> {|globalName = n; def = initDef tdName n initExpressionGlobal; body=initBody tdName n initExpressionGlobal|}) + initExpressionFnc = initExpressionFnc + initExpressionGlobalFnc = initExpressionGlobalFnc + initProcedure = initProcedure + initFunction = initFunction + initGlobal = initGlobal initTas = initTasFunction initByAsn1Value = initByAsn1Value automaticTestCases = automaticTestCases @@ -241,7 +246,7 @@ let createIntegerInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn |x::_ -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString x o.intClass) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} | [] -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString 0I o.intClass) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} | true -> {InitFunctionResult.funcBody = initInteger (lm.lg.getValue p.arg) (lm.lg.intValueToString 0I o.intClass) p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} - let constantInitExpression = + let constantInitExpression () = match isZeroAllowed with | false -> match integerVals with @@ -288,7 +293,7 @@ let createRealInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst. | [] -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) 0.0 p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} | true -> {InitFunctionResult.funcBody = initReal (lm.lg.getValue p.arg) 0.0 p.arg.isOptional resVar; resultVar = resVar; localVariables=[]} - let constantInitExpression = + let constantInitExpression () = match isZeroAllowed with | false -> match realVals with @@ -358,7 +363,7 @@ let createIA5StringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A let lvars = lm.lg.init.zeroIA5String_localVars ii let resVar = p.arg.asIdentifier {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables=lvars} - let constantInitExpression = lm.lg.initializeString (int o.maxSize.uper) + let constantInitExpression () = lm.lg.initializeString (int o.maxSize.uper) createInitFunctionCommon r lm t typeDefinition funcBody zero testCaseFuncs constantInitExpression constantInitExpression [] [] [] let createOctetStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.OctetString ) (typeDefinition:TypeDefinitionOrReference) (isValidFunction:IsValidFunction option) = @@ -378,7 +383,7 @@ let createOctetStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn | true -> initFixSizeBitOrOctString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) arrsBytes | false -> initFixVarSizeBitOrOctString (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (BigInteger arrsBytes.Length) arrsBytes let tdName = lm.lg.getLongTypedefName typeDefinition - let constantInitExpression = + let constantInitExpression () = match o.isFixedSize with | true -> lm.init.initFixSizeOctetString tdName o.maxSize.uper (o.maxSize.uper = 0I) | false -> lm.init.initVarSizeOctetString tdName o.minSize.uper o.maxSize.uper @@ -449,7 +454,7 @@ let createNullTypeInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac let funcBody (p:CallerScope) v = let resVar = p.arg.asIdentifier initNull (lm.lg.getValue p.arg) p.arg.isOptional resVar - let constantInitExpression = "0" + let constantInitExpression () = "0" let testCaseFuncs: AutomaticTestCase list = [{AutomaticTestCase.initTestCaseFunc = (fun p -> @@ -552,7 +557,7 @@ let createBitStringInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac | None -> None ) - let constantInitExpression = + let constantInitExpression () = match o.isFixedSize with | true -> lm.init.initFixSizeBitString tdName o.maxSize.uper (BigInteger o.MaxOctets) | false -> lm.init.initVarSizeBitString tdName o.minSize.uper o.maxSize.uper (BigInteger o.MaxOctets) @@ -582,7 +587,7 @@ let createBooleanInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnA | true -> {InitFunctionResult.funcBody = initBoolean (lm.lg.getValue p.arg) false p.arg.isOptional resVar; resultVar = resVar; localVariables = []} | false -> {InitFunctionResult.funcBody = initBoolean (lm.lg.getValue p.arg) true p.arg.isOptional resVar; resultVar = resVar; localVariables = []} - let constantInitExpression = lm.lg.FalseLiteral + let constantInitExpression () = lm.lg.FalseLiteral createInitFunctionCommon r lm t typeDefinition funcBody tasInitFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] @@ -608,7 +613,7 @@ let createObjectIdentifierInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t let resVar = p.arg.asIdentifier {InitFunctionResult.funcBody = initObjectIdentifier (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) 0I []; resultVar = resVar; localVariables = []} - let constantInitExpression = lm.init.initObjectIdentifierAsExpr () + let constantInitExpression () = lm.init.initObjectIdentifierAsExpr () createInitFunctionCommon r lm t typeDefinition funcBody tasInitFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] let createTimeTypeInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.TimeType ) (typeDefinition:TypeDefinitionOrReference) iv = @@ -646,7 +651,7 @@ let createTimeTypeInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Ac let tasInitFunc (p:CallerScope) = let resVar = p.arg.asIdentifier {InitFunctionResult.funcBody = initByValue p atvs.Head; resultVar = resVar; localVariables = []} - let constantInitExpression = + let constantInitExpression () = match o.timeClass with |Asn1LocalTime _-> lm.init.init_Asn1LocalTimeExpr () |Asn1UtcTime _-> lm.init.init_Asn1UtcTimeExpr () @@ -683,18 +688,18 @@ let createEnumeratedInitFunc (r: Asn1AcnAst.AstRoot) (lm: LanguageMacros) (t: As {InitFunctionResult.funcBody = initEnumerated (lm.lg.getValue p.arg) (lm.lg.getNamedItemBackendName (Some typeDefinition) vl) tdName p.arg.isOptional resVar; resultVar = resVar; localVariables=[]}); testCaseTypeIDsMap = Map.ofList [(t.id, (TcvEnumeratedValue vl.Name.Value))] }) - let constantInitExpression = lm.lg.getNamedItemBackendName (Some typeDefinition) o.items.Head + let constantInitExpression () = lm.lg.getNamedItemBackendName (Some typeDefinition) o.items.Head createInitFunctionCommon r lm t typeDefinition funcBody testCaseFuncs.Head.initTestCaseFunc testCaseFuncs constantInitExpression constantInitExpression [] [] [] let getChildExpression (lm:LanguageMacros) (childType:Asn1Type) = match childType.initFunction.initFunction with | Some cn when childType.isComplexType -> cn.funcName + (lm.lg.init.initMethSuffix childType.Kind) - | _ -> childType.initFunction.initExpression + | _ -> childType.initFunction.initExpressionFnc() let getChildExpressionGlobal (lm:LanguageMacros) (childType:Asn1Type) = match childType.initFunction.initGlobal with | Some cn when childType.isComplexType -> cn.globalName - | _ -> childType.initFunction.initExpressionGlobal + | _ -> childType.initFunction.initExpressionGlobalFnc () let createSequenceOfInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.SequenceOf ) (typeDefinition:TypeDefinitionOrReference) (childType:Asn1Type) = let initFixedSequenceOf = lm.init.initFixedSequenceOf @@ -833,8 +838,8 @@ let createSequenceOfInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A match o.isFixedSize with | true -> lm.init.initFixSizeSequenceOfExpr sTypeDef o.maxSize.uper childExpr | false -> lm.init.initVarSizeSequenceOfExpr sTypeDef o.minSize.uper o.maxSize.uper childExpr - let initExpr = constantInitExpression childInitExpr - let initExprGlob = constantInitExpression childInitGlobal + let initExpr () = constantInitExpression childInitExpr + let initExprGlob () = constantInitExpression childInitGlobal createInitFunctionCommon r lm t typeDefinition funcBody initTasFunction testCaseFuncs initExpr initExprGlob nonEmbeddedChildrenFuncs [] [] let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.Sequence) (typeDefinition:TypeDefinitionOrReference) (children:SeqChildInfo list) = @@ -868,7 +873,8 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn initSequence childrenRet let testCaseFuncs = - let asn1Children = + TL "SQ_IN_01" (fun () -> + let asn1Children () = children |> List.choose(fun c -> match c with Asn1Child x -> Some x | _ -> None) |> List.filter(fun z -> @@ -887,7 +893,7 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn let chP = {p with arg = newArg} let resVar = chP.arg.asIdentifier let chContent = atc.initTestCaseFunc chP - let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent.funcBody ch.Optionality.IsSome ch.Type.initFunction.initExpression + let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent.funcBody ch.Optionality.IsSome (ch.Type.initFunction.initExpressionFnc ()) {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = chContent.localVariables } let combinedTestCase: Map = match atc.testCaseTypeIDsMap.ContainsKey ch.Type.id with @@ -942,17 +948,15 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn testCases match r.args.generateAutomaticTestCases with - | true -> generateCases asn1Children - | false -> [] + | true -> generateCases (asn1Children ()) + | false -> []) + let initTasFunction, nonEmbeddedChildrenFuncs = - let handleChild (p:CallerScope) (ch:Asn1Child): (InitFunctionResult*InitFunction option) = + TL "SQ_IN_02" (fun () -> + let handleChild (p:CallerScope) (ch:Asn1Child): (InitFunctionResult) = let childTypeDef = ch.Type.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules let chP = {p with arg = lm.lg.getSeqChild p.arg (lm.lg.getAsn1ChildBackendName ch) ch.Type.isIA5String ch.Optionality.IsSome} let resVar = chP.arg.asIdentifier - let nonEmbeddedChildrenFunc = - match lm.lg.initMethod with - | Procedure when r.args.generateConstInitGlobals -> None - | _ -> Some ch.Type.initFunction let presentFunc (defaultValue : Asn1AcnAst.Asn1Value option) = match defaultValue with | None -> @@ -962,32 +966,58 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn | ReferenceToExistingDefinition rf when (not rf.definedInRtl) -> let fncName = (ch.Type.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules) + (lm.init.methodNameSuffix()) let chContent = initChildWithInitFunc (lm.lg.getPointer chP.arg) (fncName) - let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, nonEmbeddedChildrenFunc + let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome (ch.Type.initFunction.initExpressionFnc ()) + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] } | _ -> let fnc = ch.Type.initFunction.initTas let chContent = fnc chP - let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent.funcBody ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = chContent.localVariables }, None + let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent.funcBody ch.Optionality.IsSome (ch.Type.initFunction.initExpressionFnc ()) + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = chContent.localVariables } | Some initProc -> let chContent = initChildWithInitFunc (lm.lg.getPointer chP.arg) (initProc.funcName) - let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, nonEmbeddedChildrenFunc + let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome (ch.Type.initFunction.initExpressionFnc()) + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] } | Some dv -> let fnc = ch.Type.initFunction.initByAsn1Value let chContent = fnc chP (mapValue dv).kind - let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome ch.Type.initFunction.initExpression - {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, nonEmbeddedChildrenFunc + let funcBody = initTestCase_sequence_child (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) chContent ch.Optionality.IsSome (ch.Type.initFunction.initExpressionFnc ()) + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] } let nonPresenceFunc () = let funcBody = initTestCase_sequence_child_opt (p.arg.joined lm.lg) (lm.lg.getAccess p.arg) (lm.lg.getAsn1ChildBackendName ch) childTypeDef resVar - {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] }, None + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = [] } match ch.Optionality with | None -> presentFunc None | Some (Asn1AcnAst.Optional opt) -> presentFunc opt.defaultValue | Some (Asn1AcnAst.AlwaysAbsent) -> nonPresenceFunc () | Some (Asn1AcnAst.AlwaysPresent) -> presentFunc None + + let handleChild2 (ch:Asn1Child): (InitFunction option) = + let nonEmbeddedChildrenFunc = + match lm.lg.initMethod with + | Procedure when r.args.generateConstInitGlobals -> None + | Procedure + | Function -> Some ch.Type.initFunction + let presentFunc (defaultValue : Asn1AcnAst.Asn1Value option) = + match defaultValue with + | None -> + match ch.Type.initFunction.initProcedure with + | None -> + match ch.Type.typeDefinitionOrReference with + | ReferenceToExistingDefinition rf when (not rf.definedInRtl) -> nonEmbeddedChildrenFunc + | _ -> None + | Some initProc -> nonEmbeddedChildrenFunc + | Some _ ->nonEmbeddedChildrenFunc + + match ch.Optionality with + | None -> presentFunc None + | Some (Asn1AcnAst.Optional opt) -> presentFunc opt.defaultValue + | Some (Asn1AcnAst.AlwaysAbsent) -> None + | Some (Asn1AcnAst.AlwaysPresent) -> presentFunc None + + + let asn1Children = children |> List.choose(fun c -> match c with Asn1Child x -> Some x | _ -> None) let initTasFunction (p:CallerScope) = let resVar = p.arg.asIdentifier @@ -996,15 +1026,16 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn let initEmptySeq = initSequence_emptySeq (p.arg.joined lm.lg) {InitFunctionResult.funcBody = initEmptySeq; resultVar = resVar; localVariables = []} | _ -> - asn1Children |> - List.fold(fun (cr) ch -> - let chResult, _ = handleChild p ch - let newFuncBody = cr.funcBody + "\n" + chResult.funcBody - {InitFunctionResult.funcBody = newFuncBody; resultVar = resVar; localVariables = cr.localVariables@chResult.localVariables} - ) {InitFunctionResult.funcBody = ""; resultVar = resVar; localVariables = []} - let dummyScope = {CallerScope.modName = ""; arg = Selection.valueEmptyPath "dummy"} - let nonEmbeddedChildrenFuncs = asn1Children |> List.choose(fun ch -> handleChild dummyScope ch |> snd) - initTasFunction, nonEmbeddedChildrenFuncs + let st_list, lv = + asn1Children |> + List.fold(fun (st,lv) ch -> + let chResult = handleChild p ch + (st@[chResult.funcBody], lv@chResult.localVariables) + ) ([],[]) //{InitFunctionResult.funcBody = ""; resultVar = resVar; localVariables = []} + let funcBody = st_list |> Seq.StrJoin "\n" + {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = lv} + let nonEmbeddedChildrenFuncs = asn1Children |> List.choose(fun ch -> handleChild2 ch) + initTasFunction, nonEmbeddedChildrenFuncs) let constantInitExpression getChildExpr = let nonEmptyChildren = @@ -1029,11 +1060,12 @@ let createSequenceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn | [] -> lm.lg.getEmptySequenceInitExpression tdName | _ -> lm.init.initSequenceExpr tdName nonEmptyChildren arrsOptionalChildren - let init = constantInitExpression getChildExpression - let initGlob = constantInitExpression getChildExpressionGlobal + let init () = TL "SQ_IN_03" (fun () -> constantInitExpression getChildExpression) + let initGlob () = TL "SQ_IN_04" (fun () -> constantInitExpression getChildExpressionGlobal) + TL "SQ_IN_05" (fun () -> createInitFunctionCommon r lm t typeDefinition initByAsn1ValueFnc initTasFunction testCaseFuncs - init initGlob nonEmbeddedChildrenFuncs [] [] + init initGlob nonEmbeddedChildrenFuncs [] []) let createChoiceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o :Asn1AcnAst.Choice) (typeDefinition:TypeDefinitionOrReference) (children:ChChildInfo list) = let initTestCase_choice_child = lm.init.initTestCase_choice_child @@ -1160,7 +1192,7 @@ let createChoiceInitFunc (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAs | Some _ when r.args.generateConstInitGlobals -> None | Some _ -> Some ch.chType.initFunction) - let constantInitExpression getChildExp = + let constantInitExpression getChildExp () = children |> List.map (fun c -> let childName = lm.lg.getAsn1ChChildBackendName c @@ -1197,7 +1229,7 @@ let createReferenceType (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst let bs = baseType.initFunction match TypesEquivalence.uperEquivalence t1 t1WithExtensions with | false -> - createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value bs.initTas bs.automaticTestCases bs.initExpression bs.initExpressionGlobal bs.nonEmbeddedChildrenFuncs [] [] + createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value bs.initTas bs.automaticTestCases bs.initExpressionFnc bs.initExpressionGlobalFnc bs.nonEmbeddedChildrenFuncs [] [] | true -> match t.isComplexType with | true -> @@ -1210,12 +1242,12 @@ let createReferenceType (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst match t.id.ModName = o.modName.Value with | true -> funcName, globalName | false -> moduleName + "." + funcName, moduleName + "." + globalName - let constantInitExpression = baseFncName + lm.lg.init.initMethSuffix baseType.Kind - let constantInitExpressionGlobal = baseGlobalName + let constantInitExpression () = baseFncName + lm.lg.init.initMethSuffix baseType.Kind + let constantInitExpressionGlobal () = baseGlobalName let initTasFunction (p:CallerScope) = let resVar = p.arg.asIdentifier let funcBody = initChildWithInitFunc (lm.lg.getPointer p.arg) baseFncName {InitFunctionResult.funcBody = funcBody; resultVar = resVar; localVariables = []} createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value initTasFunction bs.automaticTestCases constantInitExpression constantInitExpressionGlobal nonEmbeddedChildrenFuncs [] [] | false -> - createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value bs.initTas bs.automaticTestCases bs.initExpression bs.initExpressionGlobal bs.nonEmbeddedChildrenFuncs [] [] + createInitFunctionCommon r lm t typeDefinition bs.initByAsn1Value bs.initTas bs.automaticTestCases bs.initExpressionFnc bs.initExpressionGlobalFnc bs.nonEmbeddedChildrenFuncs [] [] diff --git a/BackendAst/DAstTypeDefinition.fs b/BackendAst/DAstTypeDefinition.fs index f7e8c4cdc..7262d9424 100644 --- a/BackendAst/DAstTypeDefinition.fs +++ b/BackendAst/DAstTypeDefinition.fs @@ -542,16 +542,20 @@ let createString_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn let createEnumerated_u (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (us:State) = - let (aaa, priv) = - match createEnumerated r lm t o us with - | Some (a, b) -> Some a, b - | None -> None, None let programUnit = ToC t.id.ModName let td = lm.lg.getEnumTypeDefinition o.typeDef match td.kind with | NonPrimitiveNewTypeDefinition -> + let (aaa, priv) = + match createEnumerated r lm t o us with + | Some (a, b) -> Some a, b + | None -> None, None TypeDefinition {TypeDefinition.typedefName = td.typeName; typedefBody = (fun () -> aaa.Value); privateTypeDefinition=priv; baseType=None} | NonPrimitiveNewSubTypeDefinition subDef -> + let (aaa, priv) = + match createEnumerated r lm t o us with + | Some (a, b) -> Some a, b + | None -> None, None let baseType = {ReferenceToExistingDefinition.programUnit = (if subDef.programUnit = programUnit then None else Some subDef.programUnit); typedefName=subDef.typeName ; definedInRtl = false} TypeDefinition {TypeDefinition.typedefName = td.typeName; typedefBody = (fun () -> aaa.Value); privateTypeDefinition=priv; baseType=Some baseType} | NonPrimitiveReference2OtherType -> diff --git a/BackendAst/DAstUPer.fs b/BackendAst/DAstUPer.fs index 3bc5fe5fe..9f54d0468 100644 --- a/BackendAst/DAstUPer.fs +++ b/BackendAst/DAstUPer.fs @@ -756,7 +756,7 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Com let childResultExpr = TL "handleChild_11" (fun () -> match codec, lm.lg.decodingKind with - | Decode, Copy -> Some child.Type.initFunction.initExpression + | Decode, Copy -> Some (child.Type.initFunction.initExpressionFnc ()) | _ -> None) {stmt=None; resultExpr=childResultExpr; props=props; auxiliaries = []}, newAcc | Some childContent -> @@ -870,7 +870,7 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Commo let sChildTypeDef = child.chType.typeDefinitionOrReference.longTypedefName2 lm.lg.hasModules let isSequence = match child.chType.Kind with | Sequence _ -> true | _ -> false let isEnum = match child.chType.Kind with | Enumerated _ -> true | _ -> false - let sChildInitExpr = child.chType.initFunction.initExpression + let sChildInitExpr = child.chType.initFunction.initExpressionFnc() let sChoiceTypeName = typeDefinitionName let mk_choice_child (childContent: string): string = diff --git a/BackendAst/DAstVariables.fs b/BackendAst/DAstVariables.fs index edf21684c..58aedb9e0 100644 --- a/BackendAst/DAstVariables.fs +++ b/BackendAst/DAstVariables.fs @@ -115,7 +115,7 @@ let rec printValue (r:DAst.AstRoot) (lm:LanguageMacros) (curProgramUnitName:str | SequenceOf so -> let td = lm.lg.getSizeableTypeDefinition so.baseInfo.typeDef let childVals = v |> List.map (fun chv -> printValue r lm curProgramUnitName so.childType (Some gv) chv.kind) - let sDefValue = so.childType.initFunction.initExpression + let sDefValue = so.childType.initFunction.initExpressionFnc () lm.vars.PrintSequenceOfValue td (so.baseInfo.minSize.uper = so.baseInfo.maxSize.uper) (BigInteger v.Length) childVals sDefValue | _ -> raise(BugErrorException "unexpected type") | SeqValue v -> @@ -148,8 +148,8 @@ let rec printValue (r:DAst.AstRoot) (lm:LanguageMacros) (curProgramUnitName:str | Some v -> let chV = (mapValue v).kind Some (printValue r lm curProgramUnitName x.Type None chV) - | None -> if lm.lg.supportsInitExpressions then (Some x.Type.initFunction.initExpression) else None - | _ -> if lm.lg.supportsInitExpressions then (Some x.Type.initFunction.initExpression) else None + | None -> if lm.lg.supportsInitExpressions then (Some (x.Type.initFunction.initExpressionFnc ())) else None + | _ -> if lm.lg.supportsInitExpressions then (Some (x.Type.initFunction.initExpressionFnc ())) else None match chV with | None -> None | Some chV -> Some (lm.vars.PrintSequenceValueChild (lm.lg.getAsn1ChildBackendName x) chV )) @@ -301,7 +301,7 @@ let createSequenceOfFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1A match gv with | SeqOfValue chVals -> let childVals = chVals |> List.map (fun chv -> childType.printValue curProgramUnitName (Some gv) chv.kind) - let sDefValue = childType.initFunction.initExpression + let sDefValue = childType.initFunction.initExpressionFnc () let td = lm.lg.getSizeableTypeDefinition o.typeDef PrintSequenceOfValue td (o.minSize.uper = o.maxSize.uper) (BigInteger chVals.Length) childVals sDefValue @@ -347,8 +347,8 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (t:Asn1Acn | Some zz -> let v = (mapValue zz).kind Some(x.Type.printValue curProgramUnitName (Some gv) v) - | None -> match lm.lg.supportsInitExpressions with false -> None | true -> Some (x.Type.initFunction.initExpression) - | _ -> match lm.lg.supportsInitExpressions with false -> None | true -> Some (x.Type.initFunction.initExpression) + | None -> match lm.lg.supportsInitExpressions with false -> None | true -> Some (x.Type.initFunction.initExpressionFnc ()) + | _ -> match lm.lg.supportsInitExpressions with false -> None | true -> Some (x.Type.initFunction.initExpressionFnc ()) match childValue with | None -> None | Some childValue -> Some (PrintSequenceValueChild (lm.lg.getAsn1ChildBackendName x) childValue) ) diff --git a/CommonTypes/CommonTypes.fs b/CommonTypes/CommonTypes.fs index 4a82ebfeb..b29710de1 100644 --- a/CommonTypes/CommonTypes.fs +++ b/CommonTypes/CommonTypes.fs @@ -947,8 +947,9 @@ type CommandLineSettings = { TypePrefix:string CheckWithOss:bool AstXmlAbsFileName:string - IcdUperHtmlFileName:string - IcdAcnHtmlFileName:string + //IcdUperHtmlFileName:string + //IcdAcnHtmlFileName:string + generateAcnIcd: bool custom_Stg_Ast_Version : int icdPdus : (string list) option mappingFunctionsModule : string option diff --git a/FrontEndAst/DAst.fs b/FrontEndAst/DAst.fs index a3b06e6ef..5a3632ce3 100644 --- a/FrontEndAst/DAst.fs +++ b/FrontEndAst/DAst.fs @@ -283,14 +283,19 @@ type InitProcedure0 = { def:string; body:string } +type InitGlobal = { + globalName:string; + def:string; + body:string +} type InitFunction = { - initExpression : string // an expression that provides the default initialization. - initExpressionGlobal : string // an expression that provides the default initialization. + initExpressionFnc : unit -> string // an expression that provides the default initialization. + initExpressionGlobalFnc : unit -> string // an expression that provides the default initialization. //It is usually present except of some rare cases such as an empty sequence (for C only) etc initProcedure : InitProcedure0 option initFunction : InitProcedure0 option // an expression that initializes the given type to a default value. - initGlobal : {|globalName:string; def:string; body:string |} option // an expression that initializes the given type to a default value. + initGlobal : InitGlobal option // an expression that initializes the given type to a default value. initTas : (CallerScope -> InitFunctionResult) // returns the statement(s) that defaults initialize this type (used in the init function) initByAsn1Value : CallerScope -> Asn1ValueKind -> string // returns the statement(s) that initialize according to the asn1value @@ -1070,6 +1075,7 @@ with | TimeType _ -> "TIME" let getNextValidErrorCode (cur:State) (errCodeName:string) (comment:string option) = + TL "getNextValidErrorCode" (fun () -> let rec getErrorCode (errCodeName:string) = match cur.curErrCodeNames.Contains errCodeName with | false -> {ErrorCode.errCodeName = errCodeName; errCodeValue = cur.currErrorCode; comment=comment} @@ -1077,7 +1083,7 @@ let getNextValidErrorCode (cur:State) (errCodeName:string) (comment:string optio getErrorCode (errCodeName + "_2") let errCode = getErrorCode (errCodeName.ToUpper()) - errCode, {cur with currErrorCode = cur.currErrorCode + 1; curErrCodeNames = cur.curErrCodeNames.Add errCode.errCodeName} + errCode, {cur with currErrorCode = cur.currErrorCode + 1; curErrCodeNames = cur.curErrCodeNames.Add errCode.errCodeName}) type TypeAssignment = { Name:StringLoc diff --git a/FrontEndAst/LspAst.fs b/FrontEndAst/LspAst.fs index 7b6ac59dd..90e8f7cff 100644 --- a/FrontEndAst/LspAst.fs +++ b/FrontEndAst/LspAst.fs @@ -92,8 +92,9 @@ let defaultCommandLineSettings = TypePrefix = "" CheckWithOss = false AstXmlAbsFileName = "" - IcdUperHtmlFileName = "" - IcdAcnHtmlFileName = "" + //IcdUperHtmlFileName = "" + //IcdAcnHtmlFileName = "" + generateAcnIcd = false custom_Stg_Ast_Version = 1 mappingFunctionsModule = None integerSizeInBytes = 8I diff --git a/asn1scc/Program.fs b/asn1scc/Program.fs index a84aba7e5..b975ecdf0 100644 --- a/asn1scc/Program.fs +++ b/asn1scc/Program.fs @@ -317,8 +317,10 @@ let constructCommandLineSettings args (parserResults: ParseResults TypePrefix = parserResults.GetResult(<@ Type_Prefix@>, defaultValue = "") CheckWithOss = false AstXmlAbsFileName = parserResults.GetResult(<@Xml_Ast@>, defaultValue = "") - IcdUperHtmlFileName = "" - IcdAcnHtmlFileName = "" + //IcdUperHtmlFileName = "" + //IcdAcnHtmlFileName = "" + generateAcnIcd = + parserResults.Contains <@ IcdAcn @> || parserResults.Contains <@ CustomIcdAcn @> generateConstInitGlobals = parserResults.Contains(<@Init_Globals@>) custom_Stg_Ast_Version = parserResults.GetResult(<@ Custom_Stg_Ast_Version @>, defaultValue = 1) icdPdus =