Skip to content

Commit

Permalink
Add PDU detection and tracking mechanism
Browse files Browse the repository at this point in the history 
Introduced a new mechanism to detect and track Protocol Data Units (PDUs) in the ASN.1/ACN AST.
  • Loading branch information
@usr3-1415
usr3-1415 committed Feb 9, 2025
1 parent 413b4ff commit fdbcf23
Show file tree
Hide file tree
Showing 8 changed files with 94 additions and 19 deletions.
4 changes: 4 additions & 0 deletions BackendAst/DAstACN.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2535,6 +2535,10 @@ let createReferenceFunction (r:Asn1AcnAst.AstRoot) (deps:Asn1AcnAst.AcnInsertedF
| None -> us
| Some tasInfo ->
let caller = {Caller.typeId = tasInfo; funcType=AcnEncDecFunctionType}
//match List.rev t.referencedBy with
//| [] -> {Caller.typeId = tasInfo; funcType=AcnEncDecFunctionType}
//| hd::_ -> {Caller.typeId = {TypeAssignmentInfo.modName = hd.modName; tasName=hd.tasName}; funcType=AcnEncDecFunctionType}

let callee = {Callee.typeId = {TypeAssignmentInfo.modName = o.modName.Value; tasName=o.tasName.Value} ; funcType=AcnEncDecFunctionType}
addFunctionCallToState us caller callee

Expand Down
60 changes: 53 additions & 7 deletions BackendAst/DAstConstruction.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -782,6 +782,7 @@ let private createType (r:Asn1AcnAst.AstRoot) pi (t:Asn1AcnAst.Asn1Type) ((newKi
inheritInfo = t.inheritInfo
typeAssignmentInfo = t.typeAssignmentInfo
unitsOfMeasure = t.unitsOfMeasure
referencedBy = t.referencedBy
//newTypeDefName = DAstTypeDefinition2.getTypedefName r pi t
}
match us.newTypesMap.ContainsKey t.id with
Expand Down Expand Up @@ -1001,11 +1002,56 @@ let private reMapFile (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (files0:Asn
let newModules, ns = f.Modules |> foldMap (fun cs m -> reMapModule r icdStgFileName files0 deps lm m cs) us
{f with Modules = newModules}, ns

let detectPDUs2 (r:Asn1AcnAst.AstRoot) =
let callesMap =
r.allDependencies |>
List.groupBy(fun (a,_) -> a) |> //group by caller
List.map(fun (a,b) -> a, b |> List.map snd |> List.distinct) |> //remove duplicates
Map.ofList

let callesSet =
r.allDependencies |>
List.map(fun (caller, callee) -> callee) |>
Set.ofList

let rec getCallesCount (tsInfo:TypeAssignmentInfo) =
match callesMap.TryFind tsInfo with
| None -> 0
| Some l ->
let l1 = l.Length
let l2 = l |> List.map getCallesCount |> List.sum
l1 + l2

//PDUS are the types that are not called by any other types
let pdus =
seq {
for f in r.Files do
for m in f.Modules do
for tas in m.TypeAssignments do
let tsInfo = {TypeAssignmentInfo.modName = m.Name.Value; tasName = tas.Name.Value}
if not (callesSet.Contains tsInfo) then
yield (tsInfo, getCallesCount tsInfo)
} |> Seq.toList

let pudsSorted = pdus |> List.sortByDescending(fun (tas, callesCnt) -> callesCnt)
let maxToPrint = min 100 (pudsSorted.Length)
printfn "PDUs detected: %d. Printing the first %d" pudsSorted.Length maxToPrint
for (tas, callesCnt) in pudsSorted |> List.take maxToPrint do
printfn "%s.%s references %d types" tas.modName tas.tasName callesCnt

let detectPDUs (r:Asn1AcnAst.AstRoot) (us:State) =
let functionTypes = Set.ofList [AcnEncDecFunctionType]
let functionCalls = us.functionCalls |> Map.filter(fun z _ -> z.funcType = AcnEncDecFunctionType)
printfn "Detecting PDUs. Function calls: %d" functionCalls.Count

//print all calls
printfn "== Calls detected =="
functionCalls |> Seq.iter(fun fc ->
let calleesStr = sprintf "%s.%s" fc.Key.typeId.modName fc.Key.typeId.tasName
let callees = fc.Value |> List.map(fun c -> c.typeId) |> List.distinct |> List.map(fun z -> sprintf "%s.%s" z.modName z.tasName) |> Seq.StrJoin ", "
printfn "%s calls %s" calleesStr callees)
printfn "== End of calls =="

let memo = System.Collections.Generic.Dictionary<Caller, Set<Caller> >()
let rec getCallees2 bIsTass (c: Caller) =
let getCallees2_aux (c: Caller) =
Expand Down Expand Up @@ -1042,6 +1088,8 @@ let detectPDUs (r:Asn1AcnAst.AstRoot) (us:State) =
let tsInfo = {TypeAssignmentInfo.modName = m.Name.Value; tasName = tas.Name.Value}
let caller = {Caller.typeId = tsInfo; funcType = fncType}
//let calles = getCallees true caller |> List.map(fun c -> c.typeId) |> List.distinct
if tas.Name.Value = "Observable-Event" then
printfn "debug"
let calles = getCallees2 true caller |> Set.map(fun c -> c.typeId)
//printfn "Calles detected: %d" calles.Length
yield calles
Expand All @@ -1062,13 +1110,11 @@ let detectPDUs (r:Asn1AcnAst.AstRoot) (us:State) =
let caller = {Caller.typeId = tsInfo; funcType = AcnEncDecFunctionType}
//let calles = getCallees true caller |> List.map(fun c -> c.typeId) |> List.distinct
let calles = getCallees2 true caller |> Set.map(fun c -> c.typeId)
if (calles.Count > 0) then
printfn "PDU %s.%s detected. It has %d callees" m.Name.Value tas.Name.Value calles.Count
yield (tsInfo, calles)
yield (tsInfo, calles)
} |> Seq.toList

let pudsSorted = pdus |> List.sortByDescending(fun (tas, calles) -> calles.Count)
let maxToPrint = min 5 (pudsSorted.Length)
let maxToPrint = min 100 (pudsSorted.Length)
printfn "PDUs detected: %d. Printing the first %d" pudsSorted.Length maxToPrint
for (tas, calles) in pudsSorted |> List.take maxToPrint do
printfn "%s.%s references %d types" tas.modName tas.tasName calles.Count
Expand Down Expand Up @@ -1180,6 +1226,8 @@ let DoWork (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps:Asn1AcnAst.AcnIn
let files0, ns = TL "mapFile" (fun () -> r.Files |> foldMap (fun cs f -> mapFile r newTasMap icdStgFileName deps lm f cs) ns0)
let files, ns = TL "reMapFile" (fun () -> files0 |> foldMap (fun cs f -> reMapFile r icdStgFileName files0 deps lm f cs) ns)
let icdTases = ns.icdHashes
if r.args.detectPdus then
detectPDUs2 r //this function will print the PDUs detected
{
AstRoot.Files = files
acnConstants = r.acnConstants
Expand All @@ -1189,7 +1237,5 @@ let DoWork (r:Asn1AcnAst.AstRoot) (icdStgFileName:string) (deps:Asn1AcnAst.AcnIn
acnParseResults = r.acnParseResults
deps = deps
icdHashes = ns.icdHashes
callersSet =
detectPDUs r ns //this function will print the PDUs detected
calculateFunctionToBeGenerated r ns
callersSet = calculateFunctionToBeGenerated r ns
}
1 change: 1 addition & 0 deletions CommonTypes/CommonTypes.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1003,6 +1003,7 @@ type CommandLineSettings = {
generateAcnIcd: bool
custom_Stg_Ast_Version : int
icdPdus : (string list) option
detectPdus : bool
mappingFunctionsModule : string option
integerSizeInBytes : BigInteger //currently only the value of 4 or 8 bytes (32/64 bits) is supported
floatingPointSizeInBytes : BigInteger // 8 or 4
Expand Down
36 changes: 25 additions & 11 deletions FrontEndAst/AcnCreateFromAntlr.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1014,7 +1014,10 @@ let rec mapAnyConstraint (asn1:Asn1Ast.AstRoot) (t:Asn1Ast.Asn1Type) (cons:Asn1A
let oldBaseType = Asn1Ast.GetBaseTypeByName rf.modName rf.tasName asn1
mapAnyConstraint asn1 oldBaseType cons

let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map<String,int>) (lms:(ProgrammingLanguage*LanguageMacros) list) (m:Asn1Ast.Asn1Module) (t:Asn1Ast.Asn1Type) (curPath : ScopeNode list)
let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map<String,int>) (lms:(ProgrammingLanguage*LanguageMacros) list)
(m:Asn1Ast.Asn1Module)
(t:Asn1Ast.Asn1Type)
(curPath : ScopeNode list)
(typeDefPath : ScopeNode list)
(enmItemTypeDefPath : ScopeNode list)
(acnType:AcnTypeEncodingSpec option)
Expand All @@ -1026,6 +1029,8 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map
(acnParameters : AcnParameter list)
(inheritInfo : InheritanceInfo option)
(typeAssignmentInfo : AssignmentInfo option)
(referencedBy : TypeAssignmentInfo list)
(caller : TypeAssignmentInfo option)
(us:Asn1AcnMergeState) : (Asn1Type*Asn1AcnMergeState)=

let maxAlignmentOf (aligns: AcnAlignment option list): AcnAlignment option =
Expand Down Expand Up @@ -1133,7 +1138,7 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map
let acnArgsSubsted = substAcnArgs acnParamSubst (acnArgs @ Option.toList sizeDetArg)

let typeDef, us1 = getSizeableTypeDefinition tfdArg us
let newChType, us2 = mergeType asn1 acn typeIdsSet lms m chType (curPath@[SQF]) (typeDefPath@[SQF]) (enmItemTypeDefPath@[SQF]) childEncSpec None [] childWithCons acnArgs acnParamSubst [] None None us1
let newChType, us2 = mergeType asn1 acn typeIdsSet lms m chType (curPath@[SQF]) (typeDefPath@[SQF]) (enmItemTypeDefPath@[SQF]) childEncSpec None [] childWithCons acnArgs acnParamSubst [] None None referencedBy caller us1

let sizeUperRange = uPER.getSequenceOfUperRange cons t.Location
let sizeUperAcnRange = uPER.getSequenceOfUperRange (cons@wcons) t.Location
Expand Down Expand Up @@ -1256,12 +1261,12 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map

match cc with
| None ->
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) None None [] childWithCons [] acnParamSubst [] None None us
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) None None [] childWithCons [] acnParamSubst [] None None referencedBy caller us
Asn1Child ({Asn1Child.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; Optionality = newOptionality; asn1Comments = c.Comments |> Seq.toList; acnComments=[]}), us1
| Some cc ->
match cc.asn1Type with
| None ->
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList acnParamSubst [] None None us
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (typeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (enmItemTypeDefPath@[SEQ_CHILD (c.Name.Value, isOptional)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList acnParamSubst [] None None referencedBy caller us
Asn1Child ({Asn1Child.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; Optionality = newOptionality; asn1Comments = c.Comments |> Seq.toList; acnComments = cc.comments}), us1
| Some xx ->
let newType, us1 = mapAcnParamTypeToAcnAcnInsertedType asn1 lms acn xx cc.childEncodingSpec.acnProperties (curPath@[SEQ_CHILD (c.Name.Value, isOptional)]) us
Expand Down Expand Up @@ -1414,14 +1419,14 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map

match cc with
| None ->
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) None None [] childWithCons [] acnParamSubst [] None None us
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, "")]) None None [] childWithCons [] acnParamSubst [] None None referencedBy caller us
{ChChildInfo.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; acnPresentWhenConditions = acnPresentWhenConditions; asn1Comments = c.Comments|> Seq.toList; acnComments = []; present_when_name = present_when_name; Optionality = newOptionality}, us1
| Some cc ->
let enumClassName =
match us.args.targetLanguages with
| Scala::x -> typeDef[Scala].typeName
| _ -> ""
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList acnParamSubst [] None None us
let newChild, us1 = mergeType asn1 acn typeIdsSet lms m c.Type (curPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (typeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (enmItemTypeDefPath@[CH_CHILD (c.Name.Value, present_when_name, enumClassName)]) (Some cc.childEncodingSpec) None [] childWithCons cc.argumentList acnParamSubst [] None None referencedBy caller us
{ChChildInfo.Name = c.Name; _c_name = c.c_name; _scala_name = c.scala_name; _ada_name = c.ada_name; Type = newChild; acnPresentWhenConditions = acnPresentWhenConditions; asn1Comments = c.Comments |> Seq.toList; acnComments = cc.comments ; present_when_name = present_when_name; Optionality = newOptionality}, us1
let mergedChildren, chus =
match acnType with
Expand Down Expand Up @@ -1521,7 +1526,14 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map
b1,b2

let newSubst = addAcnSubst acnParamSubst baseTypeAcnParams acnArgs
let resolvedType, us2 = mergeType asn1 acn typeIdsSet lms m oldBaseType curPath newTypeDefPath newEnmItemTypeDefPath mergedAcnEncSpec (Some t.Location) restCons withCompCons acnArgs newSubst baseTypeAcnParams inheritanceInfo typeAssignmentInfo us1
let refTypeAssignInfo = {TypeAssignmentInfo.modName = rf.modName.Value; tasName = rf.tasName.Value}
let newReferencedBy = referencedBy @ [refTypeAssignInfo]
let us1a =
match caller with
| None -> us1
| Some caller ->
{us1 with allDependencies = (caller,refTypeAssignInfo)::us1.allDependencies }
let resolvedType, us2 = mergeType asn1 acn typeIdsSet lms m oldBaseType curPath newTypeDefPath newEnmItemTypeDefPath mergedAcnEncSpec (Some t.Location) restCons withCompCons acnArgs newSubst baseTypeAcnParams inheritanceInfo typeAssignmentInfo newReferencedBy (Some refTypeAssignInfo) us1a
let hasExtraConstrainsOrChildrenOrAcnArgs =
let b1 = hasAdditionalConstraints || hasChildren || acnArguments.Length > 0 || hasAcnProps
match resolvedType.Kind with
Expand Down Expand Up @@ -1589,6 +1601,7 @@ let rec private mergeType (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map
| None -> None
| Some st -> st.antlrSubTree
unitsOfMeasure = t.unitsOfMeasure
referencedBy = referencedBy

}, kindState

Expand Down Expand Up @@ -1641,7 +1654,8 @@ let private mergeTAS (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map<Strin
| None -> [], []
| Some acnTas -> acnTas.acnParameters, acnTas.comments
let typeEncodingSpec = tas.Type.acnInfo
let newType, us1 = mergeType asn1 acn typeIdsSet lms m tas.Type [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] typeEncodingSpec None [] [] [] Map.empty acnParameters None (Some (TypeAssignmentInfo {TypeAssignmentInfo.modName = m.Name.Value; tasName = tas.Name.Value})) us
let tsInfo = {TypeAssignmentInfo.modName = m.Name.Value; tasName = tas.Name.Value}
let newType, us1 = mergeType asn1 acn typeIdsSet lms m tas.Type [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] [MD m.Name.Value; TA tas.Name.Value] typeEncodingSpec None [] [] [] Map.empty acnParameters None (Some (TypeAssignmentInfo {TypeAssignmentInfo.modName = m.Name.Value; tasName = tas.Name.Value})) [] (Some tsInfo) us
let newTas =
{
TypeAssignment.Name = tas.Name
Expand All @@ -1659,7 +1673,7 @@ let private mergeValueAssignment (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet
match vas.Type.Kind with
| Asn1Ast.ReferenceType rf -> (Some ({InheritanceInfo.modName = rf.modName.Value; tasName = rf.tasName.Value; hasAdditionalConstraints=false}))//(Some {InheritanceInfo.id = ReferenceToType [MD rf.modName.Value; TA rf.tasName.Value]; hasAdditionalConstraints=false})
| _ -> None
let newType, us1 = mergeType asn1 acn typeIdsSet lms m vas.Type [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] None None [] [] [] Map.empty [] inheritInfo (Some (ValueAssignmentInfo {ValueAssignmentInfo.modName = m.Name.Value; vasName = vas.Name.Value})) us
let newType, us1 = mergeType asn1 acn typeIdsSet lms m vas.Type [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] [MD m.Name.Value; VA vas.Name.Value] None None [] [] [] Map.empty [] inheritInfo (Some (ValueAssignmentInfo {ValueAssignmentInfo.modName = m.Name.Value; vasName = vas.Name.Value})) [] None us
let newVas =
{
ValueAssignment.Name = vas.Name
Expand Down Expand Up @@ -1714,7 +1728,7 @@ let private mergeFile (asn1:Asn1Ast.AstRoot) (acn:AcnAst) (typeIdsSet : Map<Stri
//let rec registerPrimitiveTypeDefinition (us:Asn1AcnMergeState) l (id : ReferenceToType) (kind : FE_TypeDefinitionKind) getRtlDefinitionFunc : (FE_PrimitiveTypeDefinition*Asn1AcnMergeState)=
let mergeAsn1WithAcnAst (asn1: Asn1Ast.AstRoot) (lms:(ProgrammingLanguage*LanguageMacros) list) (acn: AcnGenericTypes.AcnAst, acnParseResults: CommonTypes.AntlrParserResult list) =
let typeIdsSet : Map<String,int> = calculateTypeIdsMap asn1
let initialState = {Asn1AcnMergeState.allocatedTypeNames = Map.empty; allocatedFE_TypeDefinition = Map.empty; args = asn1.args; temporaryTypesAllocation = Map.empty}
let initialState = {Asn1AcnMergeState.allocatedTypeNames = Map.empty; allocatedFE_TypeDefinition = Map.empty; args = asn1.args; temporaryTypesAllocation = Map.empty; allDependencies=[]}
let state =
seq {
for l in ProgrammingLanguage.ActiveLanguages do
Expand Down Expand Up @@ -1743,4 +1757,4 @@ let mergeAsn1WithAcnAst (asn1: Asn1Ast.AstRoot) (lms:(ProgrammingLanguage*Langua
for tas in m.TypeAssignments do
yield (m.Name.Value, tas.Name.Value), tas
} |> Map.ofSeq
{AstRoot.Files = files; args = asn1.args; acnConstants = acn.acnConstants; acnParseResults=acnParseResults; modulesMap = modulesMap; typeAssignmentsMap = typeAssignmentsMap}, acn
{AstRoot.Files = files; args = asn1.args; acnConstants = acn.acnConstants; acnParseResults=acnParseResults; modulesMap = modulesMap; typeAssignmentsMap = typeAssignmentsMap; allDependencies= finalState.allDependencies}, acn
Loading

0 comments on commit fdbcf23

Please sign in to comment.