| | | 1 | | namespace FSharp.Interop.Dlr |
| | | 2 | | |
| | | 3 | | open System |
| | | 4 | | open System.Diagnostics.CodeAnalysis |
| | | 5 | | open System.Collections.Concurrent |
| | | 6 | | open System.Reflection |
| | | 7 | | open System.Threading |
| | | 8 | | open Microsoft.FSharp.Core.CompilerServices |
| | | 9 | | |
| | | 10 | | /// The compiled-delegate cache behind `dlr { }`, keyed by the block's compiler-generated type |
| | | 11 | | /// (its state machine struct, or in the fallback path its Delay closure), which is unique per |
| | | 12 | | /// block. Exposed for diagnostics and tests. |
| | | 13 | | module DlrCache = |
| | | 14 | | |
| | | 15 | | let private cache = ConcurrentDictionary<Type, Translate.Compiled>() |
| | | 16 | | |
| | | 17 | | /// The clear generation: `clear()` bumps it, and the typed caches serve an entry only if it |
| | | 18 | | /// was compiled under the current one, however it got installed. Clearing their slots is |
| | | 19 | | /// housekeeping; the stamp is the guarantee. |
| | | 20 | | let mutable internal generation = 0 |
| | | 21 | | |
| | | 22 | | /// Listeners for `clear()`: the typed per-site caches drop their entries. |
| | | 23 | | let internal onClear = ResizeArray<unit -> unit>() |
| | | 24 | | |
| | | 25 | | /// Number of compiled `dlr { }` sites. |
| | | 26 | | let count () = cache.Count |
| | | 27 | | |
| | | 28 | | /// Drops every compiled site; the next call at each site recompiles. The dictionary is |
| | | 29 | | /// cleared *before* the generation moves: a miss that reads the new generation must not be |
| | | 30 | | /// able to find a pre-clear entry in the dictionary and install it stamped as current. |
| | | 31 | | let clear () = |
| | | 32 | | cache.Clear() |
| | | 33 | | Interlocked.Increment &generation |> ignore |
| | | 34 | | lock onClear (fun () -> for f in onClear do f ()) |
| | | 35 | | |
| | | 36 | | let internal getOrCompile (builderType: unit -> Type) (blockType: Type) (file: string) (line: int) (resultType: Type |
| | | 37 | | match cache.TryGetValue blockType with |
| | | 38 | | | true, compiled -> compiled |
| | | 39 | | | _ -> |
| | | 40 | | cache.GetOrAdd(blockType, fun t -> |
| | | 41 | | let builderType = builderType () |
| | | 42 | | let found = Discover.findBody builderType t file line |
| | | 43 | | // The compiled block's name, which a stack trace prints for its frame: the block has |
| | | 44 | | // no line numbers of its own, so this says which block it is. F#'s closure-name shape, |
| | | 45 | | // `name@line` (`run@7`), with the file in the name part since the block has no debug |
| | | 46 | | // info to supply it: `dlr__Program_fs@7`. Letters, digits and `_` only before the `@`: |
| | | 47 | | // a trace parser splits a frame at its last `.`, and a `:` or space trips others. |
| | | 48 | | // The file is cut at either separator: the path is recorded where the caller was built, |
| | | 49 | | // so a Windows path can reach a Linux run, where GetFileName keeps it whole. |
| | | 50 | | let identifier (s: string) = String(s |> Seq.map (fun c -> if Char.IsLetterOrDigit c then c else '_') |> |
| | | 51 | | let name = |
| | | 52 | | if String.IsNullOrEmpty file then "dlr__" + identifier t.Name |
| | | 53 | | else sprintf "dlr__%s@%d" (identifier (file.Substring(file.LastIndexOfAny [| '/'; '\\' |] + 1))) lin |
| | | 54 | | Translate.translate name builderType found.Context found.MemberBody t resultType found.Body) |
| | | 55 | | |
| | | 56 | | /// One compiled-machine cache entry, immutable, so a reference to it is atomic to read and to |
| | | 57 | | /// swap, stamped with the clear generation it was compiled under. |
| | | 58 | | [<AllowNullLiteral>] |
| | 4128 | 59 | | type internal MachineHit<'SM, 'T>(reader: DlrReader<'SM, 'T>, generation: int) = |
| | 0 | 60 | | member _.Reader = reader |
| | 0 | 61 | | member _.Generation = generation |
| | | 62 | | |
| | | 63 | | /// The hot path: one static slot per state machine type (per block, per instantiation of a |
| | | 64 | | /// generic member), so a call is a static field read, a generation compare and one invoke by |
| | | 65 | | /// reference. No `GetType()`, no lookup, no cast. A plain static field (no `static let`) so |
| | | 66 | | /// there is no initialization check on the read; the clear listener is registered on the first |
| | | 67 | | /// compile instead. Misses fill it from `DlrCache`, which stays the one place that compiles. |
| | | 68 | | type internal Machines<'SM, 'T> [<ExcludeFromCodeCoverage>] private () = |
| | | 69 | | [<DefaultValue>] |
| | | 70 | | static val mutable private hit : MachineHit<'SM, 'T> |
| | | 71 | | [<DefaultValue>] |
| | | 72 | | static val mutable private registered : bool |
| | | 73 | | |
| | | 74 | | static member Get(builder: obj, file: string, line: int) : DlrReader<'SM, 'T> = |
| | | 75 | | let hit = Machines<'SM, 'T>.hit |
| | | 76 | | if not (isNull hit) && hit.Generation = DlrCache.generation then hit.Reader |
| | | 77 | | else Machines<'SM, 'T>.Miss(builder, file, line) |
| | | 78 | | |
| | | 79 | | static member private Miss(builder: obj, file: string, line: int) : DlrReader<'SM, 'T> = |
| | | 80 | | let generation = Volatile.Read &DlrCache.generation |
| | | 81 | | let compiled = DlrCache.getOrCompile (fun () -> builder.GetType()) typeof<'SM> file line typeof<'T> |
| | | 82 | | let entry = MachineHit<'SM, 'T>(compiled.Delegate :?> DlrReader<'SM, 'T>, generation) |
| | | 83 | | lock DlrCache.onClear (fun () -> |
| | | 84 | | if not Machines<'SM, 'T>.registered then |
| | | 85 | | Machines<'SM, 'T>.registered <- true |
| | | 86 | | DlrCache.onClear.Add(fun () -> Machines<'SM, 'T>.hit <- null)) |
| | | 87 | | Machines<'SM, 'T>.hit <- entry |
| | | 88 | | entry.Reader |
| | | 89 | | |
| | | 90 | | /// The Delay closure out of the resumable-code delegate's target. The target is the builder's |
| | | 91 | | /// own `Delay` lambda — one compiler-generated class per result type, holding the closure in a |
| | | 92 | | /// field named `delayed` — so its reader is compiled once per `'T` (a LINQ field read; the |
| | | 93 | | /// optimizer may instead inline the lambda away, and then the target is the closure itself and |
| | | 94 | | /// the reader is the identity) and a call pays a type compare and a delegate invoke, not |
| | | 95 | | /// reflection. The last reader is one immutable object swapped atomically; a target of another |
| | | 96 | | /// type (not expected) goes to a dictionary, so alternating types cannot rebuild per call. |
| | | 97 | | type private DelayedReader(targetType: Type, read: Func<obj, obj>) = |
| | | 98 | | member _.TargetType = targetType |
| | | 99 | | member _.Read = read |
| | | 100 | | |
| | | 101 | | type internal Delayed<'T> [<ExcludeFromCodeCoverage>] private () = |
| | | 102 | | static let mutable last : DelayedReader = Unchecked.defaultof<_> |
| | | 103 | | static let readers = ConcurrentDictionary<Type, DelayedReader>() |
| | | 104 | | |
| | | 105 | | static let build (targetType: Type) = |
| | | 106 | | let read = |
| | | 107 | | match targetType.GetField("delayed", BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPubli |
| | | 108 | | | f when not (isNull f) && f.FieldType = typeof<unit -> ResumableCode<DlrData<'T>, 'T>> -> |
| | | 109 | | let target = System.Linq.Expressions.Expression.Parameter(typeof<obj>, "target") |
| | | 110 | | System.Linq.Expressions.Expression.Lambda<Func<obj, obj>>( |
| | | 111 | | System.Linq.Expressions.Expression.Field(System.Linq.Expressions.Expression.Convert(target, targetTy |
| | | 112 | | | _ when targetType.Assembly = typeof<Delayed<'T>>.Assembly -> |
| | | 113 | | // Our wrapper, but not the field we expect: the compiler's shape changed. Say so, |
| | | 114 | | // rather than treat the wrapper as the closure and key every block of this result |
| | | 115 | | // type on the one shared class. |
| | | 116 | | raise (DlrTranslationException(sprintf "dlr { } fallback path: the builder's Delay wrapper %s has no 'de |
| | | 117 | | | _ -> Func<obj, obj>(fun target -> target) |
| | | 118 | | DelayedReader(targetType, read) |
| | | 119 | | |
| | | 120 | | static member Of(target: obj) : obj = |
| | | 121 | | let t = target.GetType() |
| | | 122 | | let r = last |
| | | 123 | | let r = |
| | | 124 | | if not (obj.ReferenceEquals(r, null)) && obj.ReferenceEquals(r.TargetType, t) then r |
| | | 125 | | else |
| | | 126 | | let r = readers.GetOrAdd(t, build) |
| | | 127 | | last <- r |
| | | 128 | | r |
| | | 129 | | r.Read.Invoke target |
| | | 130 | | |
| | | 131 | | /// One closure-path cache entry, immutable and generation-stamped like `MachineHit`. |
| | | 132 | | [<AllowNullLiteral>] |
| | | 133 | | type internal SiteHit<'T>(closureType: Type, f: Func<obj, 'T>, generation: int) = |
| | | 134 | | member _.ClosureType = closureType |
| | | 135 | | member _.Func = f |
| | | 136 | | member _.Generation = generation |
| | | 137 | | |
| | | 138 | | /// The last static resumable-code delegate seen and its closure class, as one immutable pair (#175). |
| | | 139 | | [<AllowNullLiteral>] |
| | | 140 | | type internal CodeHit(code: Delegate, closureType: Type) = |
| | | 141 | | member _.Code = code |
| | | 142 | | member _.ClosureType = closureType |
| | | 143 | | |
| | | 144 | | /// The fallback path's cache, for blocks the compiler did not turn into a state machine (Debug |
| | | 145 | | /// builds): per result type, the compiled `Func<obj, 'T>` by Delay-closure type, already typed, |
| | | 146 | | /// so a call is one `GetType()`, one compare or lookup and one invoke. |
| | | 147 | | type internal Sites<'T> [<ExcludeFromCodeCoverage>] private () = |
| | | 148 | | static let sites = ConcurrentDictionary<Type, SiteHit<'T>>() |
| | | 149 | | /// The last block *compiled* (an atomic reference to an immutable entry): a block called |
| | | 150 | | /// repeatedly pays a reference compare instead of a hash lookup. Installed only on a miss, so |
| | | 151 | | /// two blocks called in turn cost a lookup each and never write. |
| | | 152 | | static let mutable last : SiteHit<'T> = null |
| | | 153 | | static do lock DlrCache.onClear (fun () -> DlrCache.onClear.Add(fun () -> sites.Clear(); last <- null)) |
| | | 154 | | |
| | | 155 | | static member Get(builder: obj, closure: obj, file: string, line: int) : Func<obj, 'T> = |
| | | 156 | | Sites<'T>.Get(builder, closure.GetType(), file, line) |
| | | 157 | | |
| | | 158 | | /// The closure class of a static resumable-code delegate (no target): the class its method |
| | | 159 | | /// lives in. `Delegate.Method` resolves a MethodInfo per call (~130 ns on a delegate the |
| | | 160 | | /// compiler allocates per call), so the last delegate seen is compared first — a static |
| | | 161 | | /// delegate's equality is its method pointer, so a re-entered block hits. The delegate and its |
| | | 162 | | /// class are one immutable pair swapped atomically: two fields could be read torn (#175). |
| | | 163 | | static member val private lastCode : CodeHit = null with get, set |
| | | 164 | | static member ClosureTypeOf(code: Delegate) : Type = |
| | | 165 | | let last = Sites<'T>.lastCode |
| | | 166 | | if not (isNull last) && last.Code.Equals code then last.ClosureType |
| | | 167 | | else |
| | | 168 | | let t = code.Method.DeclaringType |
| | | 169 | | Sites<'T>.lastCode <- CodeHit(code, t) |
| | | 170 | | t |
| | | 171 | | |
| | | 172 | | /// By closure type: `closureType` is the block's Delay closure class, or for a capture-free |
| | | 173 | | /// block left with a static delegate (see `DlrRun.Closure`) the class its `Invoke` lives in. |
| | | 174 | | static member Get(builder: obj, closureType: Type, file: string, line: int) : Func<obj, 'T> = |
| | | 175 | | let generation = Volatile.Read &DlrCache.generation |
| | | 176 | | let hit = last |
| | | 177 | | if not (isNull hit) && obj.ReferenceEquals(hit.ClosureType, closureType) && hit.Generation = generation then hit |
| | | 178 | | else |
| | | 179 | | match sites.TryGetValue closureType with |
| | | 180 | | | true, entry when entry.Generation = generation -> entry.Func |
| | | 181 | | | _ -> |
| | | 182 | | let compiled = DlrCache.getOrCompile (fun () -> builder.GetType()) closureType file line typeof<'T> |
| | | 183 | | let entry = SiteHit<'T>(closureType, compiled.Delegate :?> Func<obj, 'T>, generation) |
| | | 184 | | sites.[closureType] <- entry |
| | | 185 | | last <- entry |
| | | 186 | | entry.Func |
| | | 187 | | |
| | | 188 | | /// Why a trimmed or NativeAOT publish breaks every block: the reason the Requires* attributes on |
| | | 189 | | /// `DlrRun` give at the user's `dlr { }` line. |
| | | 190 | | module internal Unsupported = |
| | | 191 | | [<Literal>] |
| | | 192 | | let JitOnly = |
| | | 193 | | "dlr { } needs the JIT and untrimmed metadata: it reads the block's [<ReflectedDefinition>] quotation, binds thr |
| | | 194 | | |
| | | 195 | | /// <summary>The entry points the inlined <c>Run</c> compiles to. Not for direct use.</summary> |
| | | 196 | | /// <remarks>Not part of the supported API: public only because compiled blocks call it, and it may change in any releas |
| | | 197 | | [<Sealed; AbstractClass>] |
| | | 198 | | [<System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>] |
| | | 199 | | type DlrRun = |
| | | 200 | | |
| | | 201 | | /// <summary>The state machine path: <typeparamref name="SM"/> is the block's struct, a JIT constant here.</summary> |
| | | 202 | | #if NET |
| | | 203 | | [<RequiresUnreferencedCode(Unsupported.JitOnly); RequiresDynamicCode(Unsupported.JitOnly)>] |
| | | 204 | | #endif |
| | | 205 | | static member Machine<'SM, 'T>(builder: obj, sm: byref<'SM>, file: string, line: int) : 'T = |
| | | 206 | | Machines<'SM, 'T>.Get(builder, file, line).Invoke(&sm) |
| | | 207 | | |
| | | 208 | | /// <summary>The fallback path (no statically compiled state machine, e.g. Debug): the block's Delay closure is read |
| | | 209 | | #if NET |
| | | 210 | | [<RequiresUnreferencedCode(Unsupported.JitOnly); RequiresDynamicCode(Unsupported.JitOnly)>] |
| | | 211 | | #endif |
| | | 212 | | static member Closure<'T>(builder: obj, code: ResumableCode<DlrData<'T>, 'T>, file: string, line: int) : 'T = |
| | | 213 | | let target = code.Target |
| | | 214 | | if isNull target then |
| | | 215 | | // An optimized build took the non-resumable path without a warning — a block whose |
| | | 216 | | // function-typed result is applied on the spot, `(dlr { … } : unit -> R) ()` — and, |
| | | 217 | | // the block capturing nothing, inlined its Delay closure into a static delegate whose |
| | | 218 | | // method lives in the closure class. Nothing to read at a call: compile from that |
| | | 219 | | // class and pass no closure. |
| | | 220 | | let closureType = Sites<'T>.ClosureTypeOf code |
| | | 221 | | if isNull closureType || closureType.Assembly = typeof<DlrRun>.Assembly then |
| | | 222 | | raise (DlrTranslationException(sprintf "dlr { } at %s:%d has no state machine and no closure to compile |
| | | 223 | | Sites<'T>.Get(builder, closureType, file, line).Invoke null |
| | | 224 | | else |
| | | 225 | | let closure = Delayed<'T>.Of target |
| | | 226 | | Sites<'T>.Get(builder, closure, file, line).Invoke closure |