diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index 8d9d75e12a8..911e6663bf1 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -189,6 +189,7 @@ * Direct delegate construction ([PR ##19993](https://github.com/dotnet/fsharp/pull/19993)) * IL: add `ILPreNamespace`, make `ILPreTypeDef` creation lazy ([PR #20092](https://github.com/dotnet/fsharp/pull/20092)) * IL: share ILCallingConv instances ([PR #20254](https://github.com/dotnet/fsharp/pull/20254)) +* IL: intern the attributes and type references read from metadata ([PR #20486](https://github.com/dotnet/fsharp/pull/20486)) * IL: cache the ILTypeRef of a type def ([PR #20259](https://github.com/dotnet/fsharp/pull/20259)) * IL: use empty tables for members when possible ([PR #20249](https://github.com/dotnet/fsharp/pull/20249)) * Make Entity's adhoc members list lazy ([PR #20286](https://github.com/dotnet/fsharp/pull/20286/changes)) diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index d1728dc36d2..ed62023b830 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -15,6 +15,7 @@ open System.Collections.Generic open System.Diagnostics open System.IO open System.Text +open type System.Threading.Interlocked open Internal.Utilities.Collections open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL @@ -59,6 +60,58 @@ let stronglyHeldReaderCacheSize = with _ -> stronglyHeldReaderCacheSizeDefault +/// Readers are shared process-wide, and each reads the same values again. Bounded, because an entry +/// outlives the reader that produced it: past the cap values simply stay unshared. +[] +type private InternTable<'T when 'T: not null and 'T: not struct and 'T: equality>(capacity: int, ?comparer: IEqualityComparer<'T>) = + let table = + ConcurrentDictionary<'T, 'T>(defaultArg comparer HashIdentity.Structural) + + let mutable count = 0 + + member _.Intern(v: 'T) = + match table.TryGetValue v with + | true, existing -> existing + | _ when count >= capacity -> v + | _ -> + let interned = table.GetOrAdd(v, v) + + if obj.ReferenceEquals(interned, v) then + Increment(&count) |> ignore + + interned + + member _.Clear() = + table.Clear() + Exchange(&count, 0) |> ignore + +/// Constructors are interned first, so comparing one by reference replaces walking its method ref, +/// argument types and assembly ref on every attribute read. +[] +type private EncodedAttributeComparer() = + interface IEqualityComparer with + member _.Equals(x, y) = + match x, y with + | ILAttribute.Encoded(m1, d1, []), ILAttribute.Encoded(m2, d2, []) -> obj.ReferenceEquals(m1, m2) && d1 = d2 + | _ -> x = y + + member _.GetHashCode(x) = + match x with + | ILAttribute.Encoded(m, d, []) -> + let mutable h = LanguagePrimitives.PhysicalHash m + + for i in 0 .. min d.Length 16 - 1 do + h <- (h * 31) ^^^ int d[i] + + (h * 31) ^^^ d.Length + | x -> hash x + +let private internedAttributes = + InternTable(8192, EncodedAttributeComparer()) + +let private internedAttributeCtors = InternTable(2048) +let private internedTypeRefs = InternTable(8192) + let singleOfBits (x: int32) = BitConverter.ToSingle(BitConverter.GetBytes x, 0) @@ -1140,6 +1193,7 @@ type ILMetadataReader = seekReadMemberRefAsMethodData: MemberRefAsMspecIdx -> VarArgMethodData seekReadMemberRefAsFieldSpec: MemberRefAsFspecIdx -> ILFieldSpec seekReadCustomAttr: CustomAttrIdx -> ILAttribute + seekReadCustomAttrType: TaggedIndex -> ILMethodSpec seekReadTypeRef: int -> ILTypeRef seekReadTypeDefAsTypeRef: int -> ILTypeRef seekReadTypeRefAsType: TypeRefAsTypIdx -> ILType @@ -2399,7 +2453,7 @@ and seekReadTypeRefUncached ctxtH idx = let scopeIdx, nameIdx, namespaceIdx = seekReadTypeRefRow ctxt mdv idx let scope, enc = seekReadTypeRefScope ctxt mdv scopeIdx let nm = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) - ILTypeRef.Create(scope = scope, enclosing = enc, name = nm) + internedTypeRefs.Intern(ILTypeRef.Create(scope = scope, enclosing = enc, name = nm)) and seekReadTypeRefAsType (ctxt: ILMetadataReader) boxity ginst idx = ctxt.seekReadTypeRefAsType (TypeRefAsTypIdx(boxity, ginst, idx)) @@ -2463,19 +2517,26 @@ and seekReadMethodDefOrRefNoVarargs (ctxt: ILMetadataReader) numTypars x = MethodData(enclTy, cc, nm, argTys, retTy, methInst) -and seekReadCustomAttrType (ctxt: ILMetadataReader) (TaggedIndex(tag, idx)) = - match tag with - | tag when tag = cat_MethodDef -> - let (MethodData(enclTy, cc, nm, argTys, retTy, methInst)) = - seekReadMethodDefAsMethodData ctxt idx +and seekReadCustomAttrType (ctxt: ILMetadataReader) idx = ctxt.seekReadCustomAttrType idx - mkILMethSpecInTy (enclTy, cc, nm, argTys, retTy, methInst) - | tag when tag = cat_MemberRef -> - let (MethodData(enclTy, cc, nm, argTys, retTy, methInst)) = - seekReadMemberRefAsMethDataNoVarArgs ctxt 0 idx +and seekReadCustomAttrTypeUncached ctxtH (TaggedIndex(tag, idx)) = + let (ctxt: ILMetadataReader) = getHole ctxtH - mkILMethSpecInTy (enclTy, cc, nm, argTys, retTy, methInst) - | _ -> failwith "seekReadCustomAttrType ctxt" + let spec = + match tag with + | tag when tag = cat_MethodDef -> + let (MethodData(enclTy, cc, nm, argTys, retTy, methInst)) = + seekReadMethodDefAsMethodData ctxt idx + + mkILMethSpecInTy (enclTy, cc, nm, argTys, retTy, methInst) + | tag when tag = cat_MemberRef -> + let (MethodData(enclTy, cc, nm, argTys, retTy, methInst)) = + seekReadMemberRefAsMethDataNoVarArgs ctxt 0 idx + + mkILMethSpecInTy (enclTy, cc, nm, argTys, retTy, methInst) + | _ -> failwith "seekReadCustomAttrTypeUncached" + + internedAttributeCtors.Intern spec and seekReadImplAsScopeRef (ctxt: ILMetadataReader) mdv (TaggedIndex(tag, idx)) = if idx = 0 then @@ -3345,7 +3406,7 @@ and seekReadCustomAttrUncached ctxtH (CustomAttrIdx(cat, idx, valIdx)) = | None -> Bytes.ofInt32Array [||] let elements = [] - ILAttribute.Encoded(method, data, elements) + internedAttributes.Intern(ILAttribute.Encoded(method, data, elements)) and securityDeclsReader ctxtH tag = mkILSecurityDeclsReader (fun idx -> @@ -4495,6 +4556,9 @@ let openMetadataReader let cacheMemberRefAsMemberData = mkCacheGeneric reduceMemoryUsage inbase "MemberRefAsMemberData" (getNumRows TableNames.MemberRef / 20 + 1) + let cacheCustomAttrType = + mkCacheGeneric reduceMemoryUsage inbase "CustomAttrType" (getNumRows TableNames.CustomAttribute / 20 + 1) + let cacheCustomAttr = mkCacheGeneric reduceMemoryUsage inbase "CustomAttr" (getNumRows TableNames.CustomAttribute / 50 + 1) @@ -4588,6 +4652,7 @@ let openMetadataReader seekReadMemberRefAsMethodData = cacheMemberRefAsMemberData (seekReadMemberRefAsMethodDataUncached ctxtH) seekReadMemberRefAsFieldSpec = seekReadMemberRefAsFieldSpecUncached ctxtH seekReadCustomAttr = cacheCustomAttr (seekReadCustomAttrUncached ctxtH) + seekReadCustomAttrType = cacheCustomAttrType (seekReadCustomAttrTypeUncached ctxtH) seekReadTypeRef = cacheTypeRef (seekReadTypeRefUncached ctxtH) seekReadTypeDefAsTypeRef = cacheTypeDefAsTypeRef (seekReadTypeDefAsTypeRefUncached ctxtH) readBlobHeapAsPropertySig = cacheBlobHeapAsPropertySig (readBlobHeapAsPropertySigUncached ctxtH) @@ -5099,6 +5164,9 @@ let OpenILModuleReaderFromStream fileName (peStream: Stream) options = let ClearAllILModuleReaderCache () = ilModuleReaderCache1.Clear(ILModuleReaderCache1LockToken()) ilModuleReaderCache2.Clear() + internedAttributes.Clear() + internedAttributeCtors.Clear() + internedTypeRefs.Clear() let OpenILModuleReader fileName opts = // Pseudo-normalize the paths.