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